home *** CD-ROM | disk | FTP | other *** search
- ⓪ MODULE MM2Link; (*$Z+,M+,C-,Q+,P+,V+,R-*)⓪ ⓪ (*⓪ IMPORT TOSDebug;⓪ *)⓪ ⓪ (*⓪!* Format der Argumentzeile beim Aufruf:⓪!* MM2LINK codename {-M|-V|-H|-F|-0|-1|-2|⓪!* -Oprgname|-Rmaxreloc|-Sargs|-Iargs|⓪!* -Ddatasize|-Ddatafile}⓪!*)⓪ ⓪ (* Copyright (c) 1985 Juergen Mueller, 1986 Thomas Tempelmann⓪ * V#0684⓪ *⓪ * 08.12.85 : Juergen Mueller : Grundversion 1.0⓪ * 27.06.86 : TT : Atari-Relozier-vers 1.0⓪ * 21.07.86 : TT : Atari-Relozier-vers 1.1 (schneller)⓪ * 21.07.86 : TT : V1.1 lauffähig für Atari⓪ * 23.07.86 : TT : V1.2 mit untersch. Suffixe f. Impl/Prg⓪ * 24.10.86 : TT : V1.3 Fehler in ImportLen behoben; Initmodul⓪ * wird mit eingelinkt; ModLst wird abgelegt f.⓪ * Loader; HeadSkip raus⓪ * 27.10.86 : TT : V1.4 neuer name: 'prginint.mod';⓪ * 08.02.87 : TT : V1.5, ShortModLst wird anders abgelegt.⓪ * 11.02.87 : TT : V1.6, SysVarSpace erweitert⓪ * 01.03.87 : TT : V1.7, Exportliste f. Vars nun richtig⓪ * 09.05.87 : TT : V1.8, Disk full wird erkannt⓪ * 23.05.87 : TT : V1.9, layout-Kennungen für REAL-Mode ausgewertet⓪ * 24.05.87 : TT : Umstellung auf MOS⓪ * 06.06.87 : TT : V1.10 Fehleranzeige, wenn Relocate() schiefgeht⓪ * 07.06.87 : TT : V1.11 Init-Prg darf importieren⓪ * 11.06.87 : TT : V1.12 Init-Mod erscheint nicht in ShModLst,⓪ * dafür endlich letztes Modul.⓪ * 14.06.87 : TT : V1.13 ShModLst erweitert⓪ * 17.06.87 : TT : V1.14 Nur ein Main-Mod geht jetzt auch richtig.⓪ * 19.06.87 : TT : V1.15 Init-Aufrufe korrigiert⓪ * 21.07.87 : TT : V1.16 Modnames: nur erste 8 Zeichen signifikant⓪ * 25.07.87 : TT : V1.17 PDB um savedSSP,savedSR erweitert⓪ * 30.08.87 : TT : Dateinamen besser behandelt, Codename wird⓪ * korrekt aus Modulcode geholt.⓪ * 09.09.87 : TT : V1.19 Stacksize bestimmbar⓪ * 26.10.87 : TT : V1.20 ShModLst: VarAd wird auch reloziert.⓪ * 02.11.87 : MCH / TT : V1.21 Accessory-fähig, geänd. Layout f. Init-Prg⓪ * 04.11.87 : TT : V1.22 Mehrere (>2) Moduln linkbar.⓪ * 16.01.88 : TT : V1.24 'sourceName' jetzt groß genug; ShModLst⓪ * erweitert.⓪ * 22.01.88 : TT : V1.25 Main-Mods werden auf ImpPath gesucht⓪ * 29.05.88 : TT : V2.0 Mal eben den Optimierer eingebaut;⓪ * Beim Linken v. 'MOS' o. 'MTP'-Moduln wird⓪ * automatisch der 'TOS' o. 'TTP' Suffix⓪ * verwendet.⓪ * 07.06.88 : TT : Variablen-Importe werden beim Optimieren⓪ * auch berücksichtigt und ggf. ganze Module⓪ * wegoptimiert.⓪ * 08.06.88 : TT : '-S' Option, um Shell zu linken (ProcSyms⓪ * werden entfernt). ProcSyms werden mit kor-⓪ * rigiert beim Optimieren.⓪ * 10.06.88 : TT : ProcSyms bei lokalen Procs werden nicht⓪ * entfernt.⓪ * 27.06.88 : TT : V2.1 Wegoptimierte Module werden auf Bildschirm⓪ * vorm Relocate gelöscht.⓪ * 14.07.88 : TT : V2.2 Linken ohne Init-Mod lädt Hauptmod nicht⓪ * mehr doppelt.⓪ * 29.07.88 : TT : Beim Linken von Mods mit und ohne Opti-⓪ * mierdaten wird Fehler angezeigt.⓪ * 09.07.89 : TT : V2.3 Relozieren etwas beschleunigt⓪ * 10.07.89 : TT : Beim TW.Open nun 'noForce' statt⓪ * 'forceCursor', weil sonst Löschen von opt.⓪ * Modulen falsch war (liegt an GotoXY in⓪ * TextWindows).⓪ * Option f. 'noProcSyms' nun "-M" statt "-S".⓪ * Optimierung bezgl. 'useCode' verbessert.⓪ * 06.08.89 : TT : V2.4 In ShellMsg.MaxLinkMod kann Anzahl der⓪ * linkbaren Module bestimmt werden.⓪ * 17.08.89 : TT : V2.5 Fehler v. 2.4 (Bus-Error b. Reloc) behoben⓪ * 21.08.89 : TT : V2.6 Neues Layout, neue ShortModList,⓪ * $B- erlaubt Entfernung des Body beim⓪ * selektiven Linken⓪ * 31.08.89 : TT : V2.7 .MAC als Endung f. ACCs⓪ * 09.10.89 : TT : Proc-Verkettung und CodeStart (offset 42)⓪ * werden bezgl. Diff korrig.⓪ * 19.02.90 : TT : 2.8 Fastload-Bit wird immer gesetzt⓪ * 28.02.90 : TT : Real-Format wird berücksichtigt, Real-Form⓪ * & ExtendedCode werden in PDB eingetragen,⓪ * MM2LnkIO übernimmt Ein-/Ausgaben⓪ * Mit Ctrl-Tastebeim Bestätigen eines Real-⓪ * Format-Fehlers wird dieser ignoriert.⓪ * 14.03.90 : TT : 2.9 Var-Adr wird wieder richtig in ShModList⓪ * eingetragen (BSSstart addiert);⓪ * Deutlich kürzere ShModLst wird erzeugt,⓪ * da restliche Daten auch aus verbleibendem⓪ * Header ermittelt werden können.⓪ * 16.05.90 : TT : 2.10 CodeID wird in Code eingefügt⓪ * 16.07.90 : TT : 2.11 Importliste wird mit übergeben; 1. Modul⓪ * (meist M2Init) wird auch in ShModList⓪ * eingetragen; mainMod werden markiert;⓪ * Format der RealFormat-Übergabe verändert.⓪ * 18.08.90 : TT : Output-Name ersetzt HomeSymbol⓪ * 04.09.90 : TT : 2.12 PrgHeader-Flags über Argzeile bestimmbar.⓪ * 07.10.90 : MCH : 2.13 Anpassung an neues 'ShellMsg'⓪ * 11.10.90 : TT : 2.14 Neue Real-Kennungen ausgewertet⓪ * 25.03.91 : TT : 2.15 "-R" erlaubt Angabe der RelocTab-Größe⓪ * 01.03.91 : M.Seyfried (MS) : RelRelocTab von 'MM2CLink' ausgewertet.⓪ * 25.04.91 : TT : 2.16 Korrektur dialog/Relocate wg. ALLOCATEs,⓪ * führte zu "Out of memory" bei 4 MB.⓪ * 03.05.91 : TT : 2.17 Neue Fehlermeldung "Reloc. table overflow"⓪ * 01.08.91 : TT/MS : 2.18 Korrektur f. MM2CLink v. MS⓪ * 16.10.91 : TT : 2.19 Protokoll/MAP-File⓪ * 28.11.92 : TT : 2.20 InitList-Output (Option -I)⓪ * 28.12.93 : TT : 2.30 Konstanten hinter Code berücksichtigt, aber⓪ * noch kein eigenes DATA-Segment.⓪ * 14.01.94 : TT : 2.31 "-D" für DATA-Segment-Erzeugung⓪ * 26.09.94 : : 2.32 s. Notiz zum Datum.⓪ * 09.01.95 : TT : 2.33 Abfrage auf Proc-Länge=0, damit keine End-⓪ * losschleife beim Opt. entsteht (getProcs).⓪ *)⓪ ⓪ FROM SYSTEM IMPORT ASSEMBLER, ADDRESS, WORD, BYTE, ADR, TSIZE, LONGWORD, CAST;⓪ FROM SysTypes IMPORT PtrAnyLongType;⓪ FROM ArgCV IMPORT PtrArgStr, InitArgCV;⓪ FROM Storage IMPORT ALLOCATE, DEALLOCATE, MemAvail;⓪ FROM Strings IMPORT Upper, Concat, Compare, Relation, Pos, Empty,⓪7StrEqual, Split, Assign, Copy, PosLen, String, Append;⓪ IMPORT FastStrings;⓪ FROM Files IMPORT Open, Create, Access, Close, Remove, FILE, ReplaceMode,⓪(State, ResetState;⓪ FROM Paths IMPORT SearchFile, ListPos;⓪ FROM PathEnv IMPORT ReplaceHome, HomePath;⓪ FROM PathCtrl IMPORT PathList;⓪ FROM Directory IMPORT MakeFullPath;⓪ FROM FileNames IMPORT SplitPath, SplitName, ConcatName, ConcatPath,⓪(FileSuffix;⓪ FROM Binary IMPORT ReadBytes, WriteBytes, Seek, SeekMode, FileSize, WriteBlock;⓪ FROM ShellMsg IMPORT ModPaths, ImpPaths, LLRange, ShellPath, LinkerParm;⓪ FROM MOSCtrl IMPORT PDB;⓪ FROM PrgCtrl IMPORT TermProcess;⓪ FROM MOSConfig IMPORT DftSfx, ImpSfx, MaxBlSize;⓪ IMPORT MOSGlobals, StrConv, Block;⓪ FROM MM2LnkIO IMPORT ClearEOP, Report, Prompt, InitOutput, VerboseOutput,⓪(Read, ReadString, WriteString, WriteMod,⓪(ClearMod, DiscardMods, ReportRealFormat, BeginWriting, ReportCodeLen,⓪(ReportLinkError, ReportIOError, ReportError, WritingOut, EndWriting,⓪(MaxSymbolLen, ModList, ModDesc, SymbolEntry, SymbolList, LongSet,⓪(OutputInitList, OutputSymbols;⓪ CONST PDBlayout = 4;⓪&version = '2.33'; (* Linker-Version *)⓪&CodeID = "Megamax Modula-2 V2";⓪ ⓪ (*⓪!* Komprimierendes Verfahren beim nicht-vollständigen Optimieren:⓪!*⓪!* Um z.B. bei der Shell Speicher zu gewinnen, wird im Prinzip⓪!* der nach der Init-Phase nicht mehr benötigte Speicher freigegeben.⓪!* Das wären z.B:⓪!* - die ShortModList, die nur vom Linker an ModBase⓪!* übergeben wird;⓪!* - alle Bodies und Hilfsroutinen, die nur vom Body⓪!* benutzt und nicht exportiert werden.⓪!*⓪!*)⓪ ⓪ VAR ok: BOOLEAN;⓪ ⓪ ⓪ PROCEDURE conc (a,b:ARRAY OF CHAR):String;⓪"VAR c:String;⓪"BEGIN⓪$concat (a,b,c,ok);⓪$RETURN c⓪"END conc;⓪ ⓪ ⓪ CONST⓪ ⓪"SysVarSpace = 52; (* layout,⓪>^basePage (f. ArgV),⓪>^modList (f. Loader),⓪>Anzahl der Einträge in modLst,⓪>processState,⓪>BottomOfStack,⓪>TopOfStack,⓪>termState,⓪>resident,⓪>flags,⓪>TermProcs,⓪>^prev,⓪>16 reserved bytes *)⓪ ⓪"ShModLstSpace = 14; (* head0: ADDRESS;⓪>var0: ADDRESS;⓪>varlen0: LONGCARD;⓪>flags: BITSET; *)⓪ ⓪(ESC = 33C;⓪ ⓪%BadIndex = 1000;⓪'anykey = 0L; (* Joker fuer Modul-Key *)⓪$DefOutSuf = '.PRG'; (* Suffix f. Output, wenn keiner angegeben *)⓪ ⓪ VAR DefImpInSuf: ARRAY [0..2] OF CHAR; (* Suffix fuer Input Impl. Files *)⓪$DefPrgInSuf: ARRAY [0..2] OF CHAR; (* Suffix fuer Input Main Files *)⓪ ⓪&ListMax: CARDINAL; (* ehemals konstant 1000 *)⓪ ⓪ TYPE⓪'tIndex = [0..BadIndex]; (* Index auf die Modul-Liste; BadIndex⓪Ckodiert Sonderfaelle: kein gueltiger⓪CIndex bzw. residentes Modul *)⓪%tModName = string;⓪ ⓪%ptrModDesc = POINTER TO tModDesc;⓪%tModDesc = RECORD⓪2image: address; (* ^Buffer beim Relozieren *)⓪1codeAd: address; (* StartAdr im ROM *)⓪2varAd: address; (* StartAdr der Variablen *)⓪0codeEnd: LONGCARD; (* entspr. Beginn der DATAs *)⓪0dataEnd: LONGCARD; (* Ende v. DATA+Code *)⓪/varStart: LONGCARD; (* Start der Variablen im Modul *)⓪1varLen: LONGCARD; (* Länge der Variablen *)⓪3diff: longcard; (* Laenge der entfernten Imp.Liste *)⓪4key: longcard; (* Key dieses Moduls *)⓪1modlen: longcard; (* Code-Länge dieses Moduls *)⓪-sourcename: ARRAY [0..11] OF CHAR;⓪-symbolname: ARRAY [0..11] OF CHAR;⓪/codename: ARRAY [0..99] OF CHAR;⓪3name: ARRAY [0..39] OF CHAR; (* ModulName *)⓪-symbolRoot: SymbolList;⓪0procSym: BOOLEAN;⓪/compopts: LongSet;⓪.mayRemove: BOOLEAN; (* FALSE: Body keinesfalls wegoptimieren!*)⓪0mainMod: BOOLEAN; (* FALSE: ist'n importiertes Modul *)⓪.mayCrunch: BOOLEAN; (* TRUE: Proc-Length-Liste vorhanden *)⓪/crunched: BOOLEAN;⓪+varsExported: BOOLEAN; (* TRUE: Vars werden v. anderen Mods importiert *)⓪0useCode: BOOLEAN; (* FALSE: Modulcode wird nicht gebraucht *)⓪-bodyMarked: BOOLEAN;⓪1ImpLst: POINTER TO ARRAY tIndex OF tIndex; (* Liste der imp. Module *)⓪/ImpIndex: tIndex; (* Anzahl imp. Module *)⓪/finalIdx: tIndex; (* Index für ModBase *)⓪/END;⓪ ⓪$ErrType = (NotFound, BadFormat, BadVersion, NoSpace, TooManyMods,⓪1mustnotbeimpl, badlayout, readerr, relocerr, nooptimize,⓪1badReal);⓪0⓪(pLONG = POINTER TO LONGCARD;⓪ ⓪ VAR⓪'ModLst: POINTER TO ARRAY tIndex OF tModDesc; (* Liste der geladenen Module *)⓪%ModIndex: tIndex; (* ^ letzten Eintrag in ModLst *)⓪$UsedCodes: tIndex; (* Anzahl der verw. Modulcodes *)⓪&InitLst: POINTER TO ARRAY tIndex OF tIndex; (* Liste der Init-Reihenfolge *)⓪$InitIndex: tIndex; (* ^ letzten Eintrag in InitLst *)⓪%InitIdx2: tIndex; (* ^ auf Second-Mod - InitLst *)⓪$UsedInits: tIndex; (* Anzahl der zu init. Bodies *)⓪ ⓪&outName: string; (* Name des Codefiles *)⓪!DATAFileName: String;⓪#CodeSuffix: boolean;⓪"LoadingMain: BOOLEAN;⓪%IOResult,⓪*ior: INTEGER; (* ZW fuer IOResults *)⓪ ⓪%LoadFile, (* geladene Module *)⓪&OutFile: file; (* zu schreibendes Codefile *)⓪ ⓪%protocol: BOOLEAN;⓪%initList: BOOLEAN;⓪$symbolBuf: ADDRESS;⓪$symBufEnd: ADDRESS;⓪#symBufHead: ADDRESS;⓪#symBufSize: LONGINT;⓪#symBufFact: LONGCARD;⓪"⓪&DATALen: LONGINT;⓪$DATAstart,⓪%BSSstart: LONGCARD; (* Start-Adr fuer reloz. Vars *)⓪&CodeNow, (* ^ zu vergebenden Codeplatz *)⓪'VarNow: address; (* ^ zu vergebenden Varplatz *)⓪"ShModLstLen: Longcard; (* Ges.länge der ModLst f.d. Loader *)⓪$stacksize: LONGCARD;⓪%initOffs: LONGCARD; (* rel. Adr. des Init-Einsprungs *)⓪ ⓪&BodyLen: LONGCARD; (* testweise f. Länge aller Bodies *)⓪"⓪&pRelTab,⓪&eRelTab,⓪%RelocTab: ADDRESS;⓪!firstRelVal : longcard;⓪"lastRelVal : longcard;⓪!⓪&dt_buf : RECORD (* disk transfer buffer *)⓪1dum0 : ARRAY [1..13] OF word;⓪1flen : LONGCARD;⓪1dum1 : ARRAY [16..22] OF word⓪/END;⓪&⓪%singleMod: BOOLEAN;⓪%⓪)paths: PathList;⓪ ⓪&optProcs: BOOLEAN; (* TRUE: Procs optimieren *)⓪&noHeader: BOOLEAN; (* TRUE: Header aus Moduln entfernen *)⓪$noShModLst: BOOLEAN; (* TRUE: ShortModList aus Moduln entfernen *)⓪$noProcSyms: BOOLEAN; (* TRUE: ProcSymbols vor Prozeduren entfernen *)⓪ ⓪"extendedCode: BOOLEAN;⓪&realForm: CARDINAL;⓪ ⓪#HeaderFlags: BITSET;⓪ ⓪ ⓪ PROCEDURE fputm ( f:file; VAR p:ARRAY OF word; c:LONGCARD );⓪"BEGIN⓪$WriteBytes (f, ADR (p), c);⓪"END fputm;⓪ ⓪ ⓪ PROCEDURE fput ( f:file; REF p: ARRAY OF BYTE );⓪"BEGIN⓪$IF NOT ODD (HIGH (p)) THEN HALT END;⓪$WriteBlock (f, p);⓪"END fput;⓪ ⓪ ⓪ PROCEDURE hasSuffix (s: string): boolean;⓪"VAR p: cardinal;⓪"BEGIN⓪$RETURN length (FileSuffix (s)) > 0;⓪$(* in den letzten 4 Zeichen von s muss ein Punkt stehen! *)⓪"END hasSuffix;⓪ ⓪ ⓪ PROCEDURE entry (Index: address; Displacement: LONGCARD): LongCard;⓪"(*** Long-Peek mit Displacement ***)⓪"(*$L-*)⓪"BEGIN⓪$ASSEMBLER⓪(MOVE.L -(A3),A0⓪(ADDA.L -(A3),A0⓪(MOVE.L (A0),D0⓪$END⓪"END entry;⓪"(*$L=*)⓪ ⓪ ⓪ PROCEDURE enter (Index: address; Displacement: cardinal; value: LongCard);⓪"(*** Long-Poke mit Displacement ***)⓪"VAR p: POINTER TO LongCard;⓪"BEGIN⓪$p:= Index + address (long (Displacement));⓪$p^:= value;⓪"END enter;⓪ ⓪ ⓪ PROCEDURE error (client, impmod: ARRAY OF CHAR; t: ErrType);⓪ ⓪"(*** Fehleranzeige auf dem Bildschirm; danach zurueck zum Aufrufer ***)⓪"⓪"VAR msg: String;⓪"⓪"BEGIN⓪$CASE t OF⓪+badReal: msg:= 'Different real-formats specified'; client[0]:= 0C |⓪(badversion: msg:= 'Wrong module version' |⓪)badformat: msg:= 'Wrong module format'; client[0]:= 0C |⓪*notfound: msg:= 'Module not found'; client[0]:= 0C |⓪+readerr: msg:= 'File is damaged'; client[0]:= 0C |⓪+nospace: msg:= 'Out of memory'; client[0]:= 0C |⓪'toomanymods: msg:= 'Too many modules (enlarge "max. Module")'; client[0]:= 0C|⓪%mustnotbeimpl: msg:= 'Init-module must be program module'; client[0]:= 0C|⓪)badlayout: msg:= 'Bad module layout'; client[0]:= 0C|⓪*relocerr: msg:= 'Error in relocation list'; client[0]:= 0C|⓪(nooptimize: msg:= 'Old module layout - may not be optimized'; client[0]:= 0C|⓪$END; (* of case *)⓪$ReportLinkError (impmod, client, msg)⓪"END error;⓪ ⓪ ⓪ PROCEDURE MyError (ior: integer);⓪"BEGIN⓪$ReportIOError (ior)⓪"END MyError;⓪ ⓪ PROCEDURE RelError0 (REF s: ARRAY OF CHAR);⓪"BEGIN⓪$ReportError (s);⓪$Remove (outfile);⓪$TermProcess (MOSGlobals.OutOfMemory)⓪"END RelError0;⓪ ⓪ PROCEDURE RelError (internalErr: BOOLEAN);⓪"VAR s: String;⓪"BEGIN⓪$s:= 'Out of memory!';⓪$IF internalErr THEN Append (' (internal error!)', s, ok) END;⓪$RelError0 (s);⓪"END RelError;⓪ ⓪ PROCEDURE RelError2;⓪"BEGIN⓪$RelError0 ('Relocation table overflow! Use "-R" option.');⓪"END RelError2;⓪ ⓪ ⓪ PROCEDURE GetStr (VAR p: address): tModName;⓪"(* String aus der Importliste holen *)⓪"VAR s: tModName;⓪"BEGIN⓪$ASSEMBLER⓪,MOVE.L p(A6),A1 ;Adresse von p⓪,MOVE.L (A1),A2 ;Wert von p⓪,LEA s(A6),A0⓪%!RE13 MOVE.B (A2)+,D2 ;Zeichen holen⓪,CMPI.B #$FE,D2⓪,BCC RE12 ; -> Endmarke⓪,MOVE.B D2,(A0)+⓪,BRA RE13⓪%!RE12 BNE RE14⓪,ADDQ.L #1,A2⓪%!RE14 CLR.B (A0)+⓪,MOVE.L A2,(A1) ;p hochsetzen⓪$END;⓪$RETURN s⓪"END GetStr;⓪ ⓪ PROCEDURE SkipStr (VAR p: address);⓪"(* String aus der Importliste überspringen *)⓪"(*$L-*)⓪"BEGIN⓪$ASSEMBLER⓪,MOVE.L -(A3),A1 ;Adresse von p⓪,MOVE.L (A1),A2 ;Wert von p⓪%!RE13 CMPI.B #$FF,(A2)+⓪,BNE RE13⓪,MOVE.L A2,(A1) ;p hochsetzen⓪$END;⓪"END SkipStr;⓪"(*$L=*)⓪ ⓪ PROCEDURE SkipImpList (VAR p: address);⓪"(* Importliste überspringen *)⓪"(*$L-*)⓪"BEGIN⓪$ASSEMBLER⓪(MOVE.L -(A3),A0⓪(MOVE.L (A0),A1⓪%R6 MOVE.W (A1)+,D0 ;imp. ItemNr⓪(BEQ R5 ;fertig mit diesem Import⓪(MOVE.L (A1)+,D1 ;importiertes Item⓪(BRA R6⓪%R5 MOVE.L A1,(A0)⓪$END;⓪"END SkipImpList;⓪"(*$L=*)⓪ ⓪ ⓪ PROCEDURE SplitFileName ( REF Source: ARRAY OF CHAR; VAR Name,sfx: ARRAY OF Char );⓪"VAR dummy: MOSGlobals.PathStr;⓪"BEGIN⓪$SplitPath (source, dummy, name);⓪$SplitName (name, name, sfx)⓪"END SplitFileName;⓪ ⓪ ⓪ ⓪ PROCEDURE moveMem (olo, ohi, nlo: LONGCARD);⓪"BEGIN⓪$ASSEMBLER⓪(MOVE.L olo(A6),A0⓪(MOVE.L ohi(A6),A1⓪(MOVE.L nlo(A6),A2⓪&L MOVE.W (A0)+,(A2)+⓪(CMPA.L A1,A0⓪(BCS L⓪$END⓪"END moveMem;⓪ ⓪ ⓪ PROCEDURE isCLinkMod (modidx: CARDINAL): BOOLEAN;⓪ (*⓪!* Wert: TRUE, wenn Modul von 'MM2CLink' erzeugt wurde.⓪!*)⓪"BEGIN⓪$RETURN entry (ModLst^ [modidx].image, 50) # 0;⓪"END isCLinkMod;⓪ ⓪ ⓪ PROCEDURE Optimize;⓪ ⓪"TYPE RelocList = POINTER TO RECORD link: LONGCARD; procAddr: LONGCARD END;⓪'ProcLenEntry = RECORD start: LONGCARD; len: LONGCARD END;⓪'ProcLenList = POINTER TO ProcLenEntry;⓪'ImportTable = POINTER TO RECORD item: CARDINAL; procAddr: LONGCARD END;⓪ ⓪"(*------------- Aufbau der Listen der relativen Referenzen: ----------⓪#*⓪#* In TC-Objektdateien kommen relative Referenzen sehr häufig vor. Diese⓪#* müssen beim Optimierer sowohl beim Markieren der Procs, als auch bei der⓪#* Korrektur der Referenzen berücksichtigt werden.⓪#* TC unterscheidet zwischen 2 Byte (PCRelWordRef) und 4 Byte (PCRelLongRef)⓪#* relativen Referenzen.⓪#* Damit die relativen Referenzen durch den Optimierer berücksichtigt werden,⓪#* gibt es für die 2 byte und 4 byte relativen Referenzen zwei Listen. Der⓪#* Zeiger auf die erste Liste (2 byte relative Refs) steht im Modulheader bei⓪#* Offset 50:⓪#*⓪#* WordRelRelocListOffset = entry (image, 50)⓪#*⓪#* Der Zeiger auf die zweite Liste (4 byte relative Refs) steht unmittelbar⓪#* vor der ersten Liste:⓪#*⓪#* LongRelRelocListOffset = entry (image, WordRelRelocListOffset - 4)⓪#*⓪#* In den relativen Referenzlisten steht immer zuerst die Adresse, auf⓪#* die sich die Referenz bezieht (Entryadresse). Dann kommt eine Liste von⓪#* 2 byte bzw. 4 byte Werten, die die Lage der relativen Referenzen relativ⓪#* zu der Entryadresse angeben. Dabei bedeuten positive Werte, daß die⓪#* Referenzadresse vor der Entryadresse liegt. Um die Referenzadresse relativ⓪#* zum Modulanfang zu erhalten, sind also die Werte von der Entryadresse zu⓪#* subtrahieren! Die 2 byte bzw. 4 byte Werte sind absteigend geordnet.⓪#*⓪#* RelRelocList = { 4 byte Adresse, relativ zum Modulanfang⓪#* { 2/4 byte Referenzadresse, relativ zu obiger Adresse⓪#* } 2/4 byte Endmarke $0000⓪#* } 4 byte Endmarke $00000000⓪#*⓪#* Zugriffe auf diese Refernzliste erfolgen mit Hilfe der folgenden⓪#* Zugriffskennung und fogenden Prozeduren:⓪#*)⓪'RelRelocList = RECORD⓪9pEntryAddr : POINTER TO LONGCARD; (* ^ Entryadresse *)⓪9pRelocList : PtrAnyLongType; (* ^ RelRelocList *)⓪9long : BOOLEAN; (* 4/2 byte Addr *)⓪7END;⓪7⓪"PROCEDURE RelRefValue (REF hdl: RelRelocList): LONGINT; FORWARD;⓪"PROCEDURE FirstRelRefValue (VAR hdl: RelRelocList): LONGINT; FORWARD;⓪"PROCEDURE NextRelRefValue (VAR hdl: RelRelocList): LONGINT; FORWARD;⓪ ⓪"PROCEDURE NextRelRelocEntry (REF hdl: RelRelocList): RelRelocList;⓪"(*⓪#* Eingabe: Zugriffskennung auf relative Referenzliste⓪#* Wert : Zugriffskennung auf den nächsten Eintrag in der relativen⓪#* Referenzliste.⓪#*)⓪$VAR dummy: LONGINT;⓪(newHdl: RelRelocList;⓪$BEGIN⓪&newHdl:= hdl;⓪&(* restliche Refs. überspringen *)⓪&IF RelRefValue (newHdl) # 0 THEN⓪(WHILE NextRelRefValue (newHdl) # 0 DO END;⓪&END;⓪&WITH newHdl DO⓪((* Endekennung überspringen *)⓪(IF long THEN⓪*pEntryAddr:= CAST (ADDRESS, pRelocList) + 4;⓪(ELSE⓪*pEntryAddr:= CAST (ADDRESS, pRelocList) + 2;⓪(END;⓪(IF pEntryAddr^ # 0 THEN⓪*(* newHdl schon mal auf erste Ref. setzen *)⓪*dummy:= FirstRelRefValue (newHdl);⓪*IF pEntryAddr^ = 1 THEN⓪,(* ausgeketteten Eintrag überspringen *)⓪,RETURN NextRelRelocEntry (newHdl);⓪*END;⓪(END;⓪&END;⓪&RETURN newHdl;⓪$END NextRelRelocEntry;⓪$⓪"PROCEDURE FirstRelRelocEntry (image: ADDRESS;⓪@longList: BOOLEAN): RelRelocList;⓪"(*⓪#* Eingabe: image-Adresse; longList = TRUE => Liste mit 4 byte Werten, sonst 2⓪#* Wert : Zugriffskennung auf Liste der relativen Referenzen⓪#*)⓪$VAR hdl: RelRelocList;⓪(RelRelocListOffset: LONGCARD;⓪(dummy: LONGINT;⓪$BEGIN⓪&hdl.pEntryAddr:= NIL; (* Initialisierung *)⓪&RelRelocListOffset:= entry (image, 50);⓪&IF RelRelocListOffset = 0 THEN RETURN hdl END;⓪&IF longList THEN⓪(RelRelocListOffset:= entry (image, RelRelocListOffset - 4);⓪(IF RelRelocListOffset = 0 THEN RETURN hdl END;⓪&END;⓪&WITH hdl DO⓪(long:= longList;⓪(pEntryAddr:= image + RelRelocListOffset;⓪(IF pEntryAddr^ # 0 THEN⓪*(* hdl schon mal auf erste Ref. setzen *)⓪*dummy:= FirstRelRefValue (hdl);⓪*IF pEntryAddr^ = 1 THEN⓪,(* ausgeketteten Eintrag überspringen *)⓪,RETURN NextRelRelocEntry (hdl);⓪*END;⓪(END;⓪&END; (* WITH *)⓪&RETURN hdl;⓪$END FirstRelRelocEntry;⓪$⓪"PROCEDURE DisableRelRelocEntry (REF hdl: RelRelocList);⓪"(*⓪#* Eingabe: Zugriffskennung auf Referenzliste⓪#* Effekt : Der aktuelle Eintrag in der Refernzliste wird ausgekettet⓪#*)⓪$BEGIN⓪&hdl.pEntryAddr^:= 1;⓪$END DisableRelRelocEntry;⓪$⓪"PROCEDURE EmptyRelRelocEntry (REF hdl: RelRelocList): BOOLEAN;⓪"(*⓪#* Eingabe: Zugriffskennung auf Referenzliste⓪#* Wert : TRUE, wenn keine weiteren Daten in der Liste⓪#*)⓪$BEGIN⓪&WITH hdl DO⓪(RETURN (pEntryAddr = NIL) OR (pEntryAddr^ = 0);⓪&END;⓪$END EmptyRelRelocEntry;⓪$⓪"PROCEDURE EntryOffset (REF hdl: RelRelocList): LONGCARD;⓪"(*⓪#* Eingabe: Zugriffskennung auf RelRelocList⓪#* Wert : Entryadresse relativ zum Modulanfang⓪#*)⓪$BEGIN⓪&RETURN hdl.pEntryAddr^⓪$END EntryOffset;⓪$⓪"PROCEDURE DecEntryOffset (REF hdl: RelRelocList; diff: LONGCARD);⓪"(*⓪#* Effekt: Von der aktuellen Entryadresse wird diff abgezogen.⓪#*)⓪$BEGIN⓪&DEC (hdl.pEntryAddr^, diff);⓪$END DecEntryOffset;⓪ ⓪"PROCEDURE RelRefValue (REF hdl: RelRelocList): LONGINT;⓪"(*⓪#* Eingabe: Zugriffskennung auf Referenzliste⓪#* Wert : Adresse der aktuellen Referenz auf EntryOffset (hdl) relativ zu⓪#* EntryOffset (hdl) oder 0 nach letztem Eintrag⓪#*)⓪$BEGIN⓪&WITH hdl DO⓪(IF long THEN⓪*RETURN pRelocList^.li;⓪(ELSE⓪*RETURN pRelocList^.i1;⓪(END;⓪&END;⓪$END RelRefValue;⓪$⓪"PROCEDURE RelRefOffset (REF hdl: RelRelocList): LONGCARD;⓪"(*⓪#* wie oben, nur relativ zum Modulanfang.⓪#*)⓪$VAR offset: LONGINT;⓪$BEGIN⓪&offset:= RelRefValue (hdl);⓪&IF (offset = 0) OR (offset = 1) THEN⓪(RETURN offset;⓪&ELSE⓪(RETURN VAL (LONGCARD, VAL (LONGINT, EntryOffset (hdl)) - offset);⓪&END;⓪$END RelRefOffset;⓪$⓪"PROCEDURE DecRelRefOffset (REF hdl: RelRelocList;⓪Aimage: ADDRESS;⓪Aoffset, diff: LONGINT);⓪"(*⓪#* Eingabe: Zugriffskennung auf Referenzliste⓪#* Effekt : Die Adresse der aktuellen Referenz auf EntryOffset (hdl)⓪#* wird um diff erniedrigt.⓪#*)⓪$VAR RefImageAddr: PtrAnyLongType;⓪$BEGIN⓪&WITH hdl DO⓪(IF long THEN⓪*RefImageAddr:= image + CAST (ADDRESS, CAST (LONGINT, pEntryAddr^) -⓪ApRelocList^.li + offset);⓪*DEC (RefImageAddr^.li, diff);⓪*DEC (pRelocList^.li, diff);⓪(ELSE⓪*RefImageAddr:= image + CAST (ADDRESS, CAST (LONGINT, pEntryAddr^) -⓪AVAL (LONGINT, pRelocList^.i1) + offset);⓪*DEC (RefImageAddr^.i1, diff);⓪*DEC (pRelocList^.i1, diff);⓪(END;⓪&END;⓪$END DecRelRefOffset;⓪$⓪"PROCEDURE DisableRelRef (REF hdl: RelRelocList);⓪"(*⓪#* Eingabe: Zugriffskennung auf Referenzliste⓪#* Effekt : Die aktuelle Referenz wird aus der Liste ausgekettet⓪#*)⓪$BEGIN⓪&WITH hdl DO⓪(IF long THEN⓪*pRelocList^.li:= 1;⓪(ELSE⓪*pRelocList^.i1:= 1;⓪(END;⓪&END;⓪$END DisableRelRef;⓪$⓪"PROCEDURE FirstRelRefValue (VAR hdl: RelRelocList): LONGINT;⓪"(*⓪#* Eingabe: Zugriffskennung auf Referenzliste⓪#* Effekt : Zeiger in Zugriffskennung wird auf erste Referenz gesetzt.⓪#* Wert : Adresse der ersten Referenz auf EntryOffset (hdl) relativ zu⓪#* EntryOffset (hdl) oder 0 bei leerer Liste⓪#*)⓪$VAR offset: LONGINT;⓪$BEGIN⓪&WITH hdl DO⓪(pRelocList:= CAST (ADDRESS, pEntryAddr) + 4;⓪&END;⓪&offset:= RelRefValue (hdl);⓪&IF offset = 1 THEN⓪((* ausgekettete Referenzen überspringen *)⓪(RETURN NextRelRefValue (hdl);⓪&ELSE⓪(RETURN offset;⓪&END;⓪$END FirstRelRefValue;⓪$⓪"PROCEDURE FirstRelRefOffset (VAR hdl: RelRelocList): LONGCARD;⓪"(*⓪#* wie oben, nur relativ zum Modulanfang⓪#*)⓪$VAR dummy: LONGINT;⓪$BEGIN⓪&dummy:= FirstRelRefValue (hdl);⓪&RETURN RelRefOffset (hdl);⓪$END FirstRelRefOffset;⓪$⓪"PROCEDURE NextRelRefValue (VAR hdl: RelRelocList): LONGINT;⓪"(*⓪#* Eingabe: Zugriffskennung auf Referenzliste⓪#* Effekt : Zeiger in Zugriffskennung wird auf nächste Refernz gesetzt⓪#* Wert : Adresse der näcksten Refernz auf EntryOffset (hdl) relativ zu⓪#* EntryOffset (hdl) oder 0 bei Ende der Liste⓪#*)⓪$VAR offset: LONGINT;⓪$BEGIN⓪&WITH hdl DO⓪(IF long THEN⓪*INC (pRelocList, 4);⓪(ELSE⓪*INC (pRelocList, 2);⓪(END;⓪&END;⓪&offset:= RelRefValue (hdl);⓪&IF offset = 1 THEN⓪((* ausgekettete Referenzen überspringen *)⓪(RETURN NextRelRefValue (hdl);⓪&ELSE⓪(RETURN offset;⓪&END;⓪$END NextRelRefValue;⓪ ⓪"PROCEDURE NextRelRefOffset (VAR hdl: RelRelocList): LONGCARD;⓪"(*⓪#* wie oben, nur relativ zum Modulanfang⓪#*)⓪$VAR dummy: LONGINT;⓪$BEGIN⓪&dummy:= NextRelRefValue (hdl);⓪&RETURN RelRefOffset (hdl);⓪$END NextRelRefOffset;⓪$⓪"(*-----------------------------------------------------------------------*)⓪$⓪"PROCEDURE pStart (p: ProcLenList): LONGCARD;⓪$(*$L-*)⓪$BEGIN⓪&ASSEMBLER⓪(MOVE.L -(A3),A0⓪(MOVE.L (A0),D0 ; p^.start⓪(ANDI.L #$00FFFFFF,D0⓪&END;⓪$END pStart;⓪$(*$L=*)⓪ ⓪"PROCEDURE pEnd (p: ProcLenList): LONGCARD;⓪$(*$L-*)⓪$BEGIN⓪&ASSEMBLER⓪(MOVE.L -(A3),A0⓪(MOVE.L (A0)+,D0 ; p^.start⓪(ANDI.L #$00FFFFFF,D0⓪(ADD.L (A0),D0 ; p^.len⓪&END;⓪$END pEnd;⓪$(*$L=*)⓪ ⓪"PROCEDURE mark (p: ProcLenList; n: CARDINAL);⓪$(* n: 1='lokal verwendet', 2='von anderem Modul importiert' *)⓪$(*$L-*)⓪$BEGIN⓪&ASSEMBLER⓪(MOVE.W -(A3),D0⓪(MOVE.L -(A3),A0⓪(MOVE.B D0,(A0) ; p^.start⓪&END;⓪$END mark;⓪$(*$L=*)⓪ ⓪"PROCEDURE marked (p: ProcLenList): BOOLEAN;⓪$(*$L-*)⓪$BEGIN⓪&ASSEMBLER⓪(MOVE.L -(A3),A0⓪(TST.B (A0) ; p^.start⓪(SNE D0⓪(ANDI #1,D0⓪&END;⓪$END marked;⓪$(*$L=*)⓪ ⓪"PROCEDURE markedValue (p: ProcLenList): CARDINAL;⓪$(*$L-*)⓪$BEGIN⓪&ASSEMBLER⓪(MOVE.L -(A3),A0⓪(CLR D0⓪(MOVE.B (A0),D0 ; p^.start⓪&END;⓪$END markedValue;⓪$(*$L=*)⓪ ⓪"PROCEDURE between (v, lo, hi: LONGCARD): BOOLEAN;⓪$(*$L-*)⓪$BEGIN⓪&ASSEMBLER⓪(MOVE.L -(A3),D0 ; hi⓪(MOVE.L -(A3),D1 ; lo⓪(MOVE.L -(A3),D2 ; v⓪(CMP.L D1,D2⓪(BCS fals⓪(CMP.L D0,D2⓪(BCC fals⓪(MOVEQ #1,D0⓪(RTS⓪&fals⓪(CLR D0⓪&END;⓪$END between;⓪$(*$L=*)⓪ ⓪"PROCEDURE advance (p: LONGCARD; VAR prl: ProcLenList);⓪$(*$L-*)⓪$BEGIN⓪&ASSEMBLER⓪(MOVE.L -(A3),A2 ; ADR (prl)⓪(MOVE.L -(A3),-(A7) ; p⓪(MOVE.L (A2),A1⓪&lupo⓪(MOVE.L (A7),(A3)+⓪(MOVE.L A1,(A3)+⓪(BSR pStart/⓪(MOVE.L D0,(A3)+⓪(MOVE.L A1,(A3)+⓪(BSR pEnd/⓪(MOVE.L D0,(A3)+⓪(BSR between/⓪(BNE ende⓪(ADDQ.L #8,A1⓪(BRA lupo⓪&ende⓪(MOVE.L A1,(A2)⓪(ADDQ.L #4,A7⓪&END⓪&(*⓪&WHILE NOT between (p, pStart (prl), pEnd (prl)) DO⓪(INC (prl, SHORT (SIZE (prl^)))⓪&END;⓪&*)⓪$END advance;⓪$(*$L=*)⓪ ⓪"PROCEDURE findListEntry (idx: tIndex; ad: LONGCARD; VAR prl: ProcLenList);⓪$BEGIN⓪&WITH ModLst^ [idx] DO⓪(prl:= image + entry (image, 38)⓪&END;⓪&advance (ad, prl)⓪$END findListEntry;⓪ ⓪"PROCEDURE markCalls (modidx: tIndex; start, ende: LONGCARD);⓪ ⓪$PROCEDURE MarkRelRefProcs (image: ADDRESS; long: BOOLEAN);⓪$(*⓪%* Eingabe: Image-Adresse des betreffenden Moduls; long = TRUE => 4 byte⓪%* relative Adressen.⓪%* Effekt: Markiert Prozeduren, die relativ referenziert werden.⓪%*)⓪&VAR⓪*rRelocL: RelRelocList;⓪*procAddr: LONGCARD;⓪*prl: ProcLenList;⓪*link: LONGCARD;⓪*⓪&BEGIN⓪((* Kennung für RelRelocList *)⓪(rRelocL:= FirstRelRelocEntry (image, long);⓪(prl:= image + entry (image, 38); (* Zeiger auf Prozedurlängenliste *)⓪(WHILE NOT EmptyRelRelocEntry (rRelocL) DO⓪*(* relative Referenzliste abarbeiten *)⓪*procAddr:= EntryOffset (rRelocL);⓪*IF procAddr < entry (image, 6) THEN (* Proc, nicht Var oder Body *)⓪,advance (procAddr, prl);⓪,link:= FirstRelRefOffset (rRelocL);⓪,LOOP⓪.IF link = 0L THEN⓪0EXIT⓪.ELSIF between (link, start, ende) THEN⓪0IF ~marked (prl) THEN⓪2mark (prl,1);⓪2markCalls (modidx, pStart (prl), pEnd (prl));⓪0END;⓪0EXIT;⓪.END;⓪.link:= NextRelRefOffset (rRelocL);⓪,END⓪*END;⓪*rRelocL:= NextRelRelocEntry (rRelocL);⓪(END;⓪&END MarkRelRefProcs;⓪ ⓪$VAR⓪&image, impImg: ADDRESS;⓪&pra: RelocList;⓪&prl: ProcLenList;⓪&expl, pri: ADDRESS;⓪&imptbl: ImportTable;⓪&link: LONGCARD;⓪&idx, impIdx: tIndex;⓪ ⓪$BEGIN⓪&IF start >= ModLst^ [modidx].codeEnd THEN⓪((* Dies ist keine Proc sondern wahrscheinlich eine Const -> Abbruch *)⓪(RETURN⓪&END;⓪&⓪&image:= ModLst^ [modidx].image;⓪&⓪&IF ModLst^ [modidx].mayCrunch THEN⓪((*⓪)* Nach lokalen Procs/Consts suchen, die vom Aufrufer (start..ende)⓪)* benutzt werden:⓪)*)⓪(pra:= image + entry (image, 22); (* Liste mit Proc-Adr + Aufrufern *)⓪(prl:= image + entry (image, 38); (* Liste aller Proc-Adr./Längen *)⓪(WHILE pra^.link # NIL DO (* alle lokalen Procs/Consts durchgehen *)⓪*IF pra^.procAddr < ModLst^ [modidx].dataEnd THEN⓪,(* wir haben eine Proc o. Const *)⓪,advance (pra^.procAddr, prl); (* Const-/Proc-Länge (prl) suchen *)⓪,link:= pra^.link;⓪,LOOP⓪.(* Nun prüfen, ob diese Proc/Const vom Aufrufer benutzt wird,⓪/* indem geprüft wird, ob die Adr. dieser Proc/Const im Bereich⓪/* des Aufrufers (start..ende) einzutragen ist. *)⓪.IF link = 0L THEN⓪0EXIT (* Ende der Benutzerliste -> nicht gefunden *)⓪.ELSIF between (link, start, ende) THEN⓪0(* Gefunden: Die Proc/Const wird vom Aufrufer benutzt *)⓪0IF ~marked (prl) THEN⓪2mark (prl,1);⓪2(* Falls dies eine Proc ist, auch die hiervon benutzten⓪3* Consts/Procs markieren (Prüfung, ob's eine Proc ist,⓪3* geschieht zu Beginn v. markCalls) *)⓪2markCalls (modidx, pStart (prl), pEnd (prl))⓪0END;⓪0EXIT⓪.END;⓪.link:= entry (image, link)⓪,END⓪*END;⓪*INC (pra, 8)⓪(END;⓪((*----------- relativ referenzierte Procs markieren --------------*)⓪(MarkRelRefProcs (image, FALSE); (* für 2 byte relative Referenzen *)⓪(MarkRelRefProcs (image, TRUE); (* für 4 byte relative Referenzen *)⓪((*----------------------------------------------------------------*)⓪&END;⓪&⓪&(* Importierte Procs abarbeiten *)⓪&pri:= image + entry (image, 14);⓪&FOR idx:= 1 TO ModLst^ [modidx].ImpIndex DO⓪((* jedes importierte Modul *)⓪(impIdx:= ModLst^ [modidx].ImpLst^[idx];⓪(INC (pri, 4); (* key *)⓪(skipStr (pri); (* import-Name *)⓪(WHILE CARDINAL (pri^) # 0 DO⓪*(* jedes importierte Item *)⓪*IF ModLst^ [impIdx].mayCrunch THEN⓪,link:= entry (pri, 2);⓪,LOOP⓪.(* jeder Import des Items *)⓪.IF link = 0L THEN⓪0EXIT⓪.ELSIF between (link, start, ende) THEN⓪0(* Item in importiertem Modul finden *)⓪0impImg:= ModLst^ [impIdx].image;⓪0expl:= impImg + entry (impImg, 18);⓪0WHILE CARDINAL (expl^) # 0 DO⓪2IF expl^ = pri^ THEN⓪4(* Item gefunden *)⓪4IF entry (expl, 2) < ModLst^ [impIdx].dataEnd THEN⓪6(* Proc/Const *)⓪6findListEntry (impIdx, entry (expl, 2), prl);⓪6IF ~marked (prl) THEN⓪8mark (prl,2);⓪8markCalls (impIdx, pStart (prl), pEnd (prl))⓪6ELSE⓪8mark (prl,2); (* als importiert markieren *)⓪6END⓪4ELSE⓪6ModLst^ [impIdx].varsExported:= TRUE⓪4END;⓪4(* Jetzt gleich den 'Body' d. imp. Mods 'usen' *)⓪4WITH ModLst^ [impIdx] DO⓪6IF NOT bodyMarked THEN⓪8(* wenn bisher unbenutzt, nun seine Calls markieren *)⓪8useCode:= TRUE;⓪8bodyMarked:= TRUE;⓪8markCalls (impIdx, entry (image, 6) (*body*), codeEnd)⓪6END⓪4END;⓪4EXIT⓪2ELSE⓪4INC (expl, 6)⓪2END⓪0END;⓪0HALT (* ! Item nicht gefunden *)⓪.END;⓪.link:= entry (image, link)⓪,END; (* LOOP *)⓪*END; (* IF mayCrunch *)⓪*INC (pri, 6)⓪(END; (* WHILE pri^ # 0 *)⓪(INC (pri, 2)⓪&END (* FOR *)⓪ ⓪$END markCalls;⓪"(*$D-*)⓪ ⓪ ⓪"PROCEDURE moveCode (modIdx: tIndex; lastEnde, start, ende, newStart: LONGCARD);⓪ ⓪$PROCEDURE CorrectRelRefs (image: ADDRESS; long: BOOLEAN);⓪$(*⓪%* Eingabe: Image-Adresse; long => 4 byte Werte korrigieren⓪%* Effekt: Die relativen Referenzen werden korrigiert.⓪%*)⓪&VAR⓪*rRelocL: RelRelocList;⓪*procAddr: LONGCARD;⓪*link : LONGCARD;⓪*offset : LONGCARD;⓪*diff : LONGCARD;⓪ ⓪&BEGIN⓪(diff:= start - lastEnde; (* um diesen Wert werden Refs korrigiert *)⓪(offset:= lastEnde - newStart; (* auf link zu addierender Offset *)⓪(rRelocL:= FirstRelRelocEntry (image, long); (* Zugriffskennung *)⓪(WHILE NOT EmptyRelRelocEntry (rRelocL) DO⓪*(* Liste mit relativen Referenzen abarbeiten *)⓪*procAddr:= EntryOffset (rRelocL); (* Entryadresse merken *)⓪*IF between (procAddr, lastEnde, start) THEN⓪,(* Prozedur wird wegoptimiert => keine Referenzen auf diese Proc *)⓪,DisableRelRelocEntry (rRelocL);⓪*ELSE⓪,IF diff > 0 THEN⓪.link:= FirstRelRefOffset (rRelocL);⓪.(* Die Referenzen sind nach Codeadressen aufsteigend geordnet!!*)⓪.IF procAddr < newStart THEN⓪0WHILE (link # 0) AND (link < newStart) DO⓪2(* Refs, die nicht über wegoptimierte Procs gehen überspr. *)⓪2link:= NextRelRefOffset (rRelocL);⓪0END;⓪0WHILE (link # 0) AND (link + offset < start) DO⓪2(* Refs von wegoptimierter Proc disablen *)⓪2DisableRelRef (rRelocL);⓪2link:= NextRelRefOffset (rRelocL);⓪0END;⓪0WHILE (link # 0) DO⓪2(* restliche Refs gehen alle über wegoptimierte Proc *)⓪2(* Refs von höheren Adr. zu niedrigeren => diff addieren *)⓪2DecRelRefOffset (rRelocL, image,⓪Coffset, - VAL (LONGINT, diff));⓪2link:= NextRelRefOffset (rRelocL);⓪0END;⓪.ELSIF procAddr >= start THEN⓪0WHILE (link # 0) AND (link < lastEnde) DO⓪2(* Refs über wegoptimierte Proc korrigieren *)⓪2DecRelRefOffset (rRelocL, image,⓪C- VAL (LONGINT, offset), diff);⓪2link:= NextRelRefOffset (rRelocL);⓪0END;⓪0WHILE (link # 0) AND (link < start) DO⓪2(* Refs von wegoptimierter Proc disablen *)⓪2DisableRelRef (rRelocL);⓪2link:= NextRelRefOffset (rRelocL);⓪0END;⓪0(* restliche Refs gehen nicht über wegoptimierte Proc *)⓪.ELSE⓪0HALT; (* reloc-error *)⓪.END; (* IF *)⓪,END; (* IF *)⓪,IF between (procAddr, start, ende) THEN⓪.DecEntryOffset (rRelocL, offset + diff);⓪,END; (* IF *)⓪*END; (* IF *)⓪*rRelocL:= NextRelRelocEntry (rRelocL);⓪(END (* WHILE *);⓪&END CorrectRelRefs;⓪ ⓪$VAR pri, image: ADDRESS;⓪(link, offs: LONGCARD;⓪(p, plink: POINTER TO LONGCARD;⓪(pra: RelocList;⓪(idx: tIndex;⓪(expl: ImportTable;⓪ ⓪$PROCEDURE correct (VAR n: LONGCARD);⓪&(*$L-*)⓪&BEGIN⓪(ASSEMBLER⓪.MOVE.L D2,A0⓪.MOVE.L -(A3),A1⓪.MOVE.L offs(A0),D0⓪.SUB.L D0,(A1)⓪(END⓪&END correct;⓪&(*$L=*)⓪ ⓪$BEGIN⓪&ModLst^ [modIdx].crunched:= TRUE;⓪&image:= ModLst^ [modIdx].image;⓪&offs:= start - newStart;⓪&IF offs = 0L THEN HALT END;⓪&⓪&(*-------------- relative Relozierliste korrigieren ----------------*)⓪&CorrectRelRefs (image, FALSE); (* Korrektur für 2 byte Werte *)⓪&CorrectRelRefs (image, TRUE); (* Korrektur für 4 byte Werte *)⓪&(*------------------------------------------------------------------*)⓪&⓪&(* Relozierliste korrigieren *)⓪&pra:= image + entry (image, 22);⓪&WHILE pra^.link # NIL DO⓪(IF pra^.procAddr # 0L THEN⓪*IF between (pra^.procAddr, newstart, ende) THEN⓪,IF pra^.procAddr < start THEN⓪.pra^.procAddr:= 0 (* Diese Proc nicht mehr relozieren ! *)⓪,ELSE⓪.correct (pra^.procAddr)⓪,END⓪*END;⓪*plink:= ADR (pra^.link);⓪*LOOP⓪,link:= plink^;⓪,IF link > entry (image, 22) THEN HALT (* reloc-error *) END;⓪,IF link < newstart THEN EXIT END;⓪,IF link < ende THEN⓪.IF link < start THEN⓪0WHILE link >= newstart DO⓪2link:= entry (image, link)⓪0END;⓪0(* wegoptimierte Procs aus Ref-Liste nehmen *)⓪0IF (link = 0L) & (plink = ADR (pra^.link)) THEN⓪2pra^.procAddr:= 0 (* ganze Ref-Liste auslassen *)⓪0ELSE⓪2plink^:= link; (* unbenutze Ref auslinken *)⓪0END;⓪0EXIT⓪.ELSE⓪0correct (plink^)⓪.END⓪,END;⓪,plink:= image + link⓪*END;⓪(END; (* IF pra^.procAddr # 0L *)⓪(INC (pra, 8)⓪&END (* WHILE *);⓪&⓪&(* Importliste korrigieren *)⓪&pri:= image + entry (image, 14);⓪&FOR idx:= 1 TO ModLst^ [modidx].ImpIndex DO⓪((* jedes importierte Modul *)⓪(INC (pri, 4); (* key *)⓪(skipStr (pri); (* import-Name *)⓪(WHILE CARDINAL (pri^) # 0 DO⓪*(* jedes imp. Item *)⓪*plink:= pri + 2L;⓪*LOOP⓪,link:= plink^;⓪,IF link > entry (image, 22) THEN HALT (* reloc-error *) END;⓪,IF link < newstart THEN EXIT END;⓪,IF link < ende THEN⓪.IF link < start THEN⓪0WHILE link >= newstart DO⓪2link:= entry (image, link)⓪0END;⓪0(* wegoptimierte Procs aus Ref-Liste nehmen *)⓪0plink^:= link; (* unbenutze Ref auslinken *)⓪0EXIT⓪.ELSE⓪0correct (plink^)⓪.END⓪,END;⓪,plink:= image + link⓪*END;⓪*INC (pri, 6)⓪(END;⓪(INC (pri, 2)⓪&END; (* FOR idx *)⓪&⓪&(* Exportliste korrigieren *)⓪&expl:= image + entry (image, 18);⓪&WHILE expl^.item # 0 DO⓪(IF between (expl^.procAddr, newstart, ende) THEN⓪*IF expl^.procAddr < start THEN⓪,expl^.procAddr:= 0⓪*ELSE⓪,correct (expl^.procAddr)⓪*END⓪(END;⓪(INC (expl, 6)⓪&END (* WHILE *);⓪&⓪&(* Liste der Prozedurnamen korrigieren *)⓪&IF ModLst^ [modIdx].procSym THEN⓪(link:= entry (image, 6);⓪(LOOP⓪*plink:= image + link - 4L;⓪*link:= plink^;⓪*IF link > entry (image, 22) THEN HALT (* reloc-error *)⓪*ELSIF link < newStart THEN EXIT⓪*ELSIF link < ende THEN⓪,IF link < start THEN⓪.WHILE link >= newStart DO⓪0link:= entry (image, link-4L)⓪.END;⓪.(* wegoptimierte Procs aus Liste nehmen *)⓪.plink^:= link;⓪.EXIT⓪,ELSE⓪.correct (plink^)⓪,END⓪*END⓪(END⓪&END;⓪&⓪&(* Rumpfeinsprung korrigieren *)⓪&IF between (entry (image, 6), start, ende) THEN⓪(p:= image + 6L;⓪(correct (p^)⓪&END;⓪&⓪&(* Code verschieben *)⓪&moveMem (image + start, image + ende, image + newStart)⓪$END moveCode;⓪ ⓪ ⓪"PROCEDURE moveProcs (modIdx: tIndex);⓪ ⓪$VAR pri, imag: LONGCARD;⓪(lastFree, freeStart, usedStart, currEnd: ADDRESS;⓪(prl: ProcLenList;⓪(lastEnd: ADDRESS;⓪(offset: LONGCARD;⓪(hadSyms, remProcSym, procsExported, endOfLenList: BOOLEAN;⓪(symbol: SymbolList;⓪(body_prl: ProcLenEntry;⓪(ch: CHAR;⓪ ⓪$PROCEDURE getProc (at: LONGCARD; VAR prl: ProcLenList): BOOLEAN;⓪&(* stellt "prl" auf die Längen-Info, die zur Proc bei "at" gehört *)⓪&(*$L-*)⓪&BEGIN⓪(ASSEMBLER⓪0MOVE.L -(A3),-(A7)⓪0MOVE.L D2,A2⓪0MOVE.L -(A3),D2⓪0⓪0; der Body erscheint nicht in der Längenliste, deswegen⓪0; hierfür zuerst eine Sonderabfrage:⓪0LEA body_prl(A2),A1⓪0MOVE.L A1,(A3)+⓪0BSR pStart/⓪0CMP.L D0,D2 ; 'at' = body_prl.start?⓪0BEQ tr⓪0⓪0; ansonsten in Längenliste vom Modul suchen⓪0MOVE.L imag(A2),A0⓪0MOVE.L A0,A1⓪0ADDA.L 38(A1),A1⓪0⓪.lupo⓪0MOVE.L A1,(A3)+⓪0BSR pStart/⓪0BEQ btrf⓪0CMP.L D2,D0⓪0BNE weiter⓪0; folg. Abfrage neu in V2.33:⓪0MOVE.L A1,(A3)+⓪0BSR pEnd/⓪0CMP.L D2,D0⓪0BNE tr⓪.weiter:⓪0ADDQ.L #8,A1⓪0BRA lupo⓪.tr⓪0MOVE.L (A7)+,A0⓪0MOVE.L A1,(A0)⓪0MOVEQ #1,D0 ; RETURN TRUE⓪0RTS⓪.btrf⓪0MOVE.L (A7)+,A0⓪0MOVE.L A1,(A0)⓪0MOVE #1,endOfLenList(A2)⓪0CLR D0 ; RETURN FALSE⓪(END⓪&END getProc;⓪&(*$L=*)⓪ ⓪$PROCEDURE skipProcName (VAR ad: LONGCARD);⓪&(*$L-*)⓪&BEGIN⓪(ASSEMBLER⓪0MOVE.L D2,A2⓪0MOVE.L imag(A2),A0⓪0MOVE.L -(A3),A1⓪0MOVE.L (A1),D0⓪.L ADDQ.L #2,D0⓪0TST.B 1(A0,D0.L)⓪0BNE L⓪0ADDQ.L #6,D0⓪0MOVE.L D0,(A1)⓪(END;⓪&END skipProcName;⓪&(*$L=*)⓪ ⓪$PROCEDURE setBeforeProcName (VAR ad: LONGCARD);⓪&(*$L-*)⓪&BEGIN⓪(ASSEMBLER⓪0MOVE.L D2,A2⓪0MOVE.L imag(A2),A0⓪0MOVE.L -(A3),A1⓪0MOVE.L (A1),D0⓪0SUBQ.L #6,D0⓪.L SUBQ.L #2,D0⓪0TST.B 0(A0,D0.L)⓪0BNE L⓪0MOVE.L D0,(A1)⓪(END;⓪&END setBeforeProcName;⓪&(*$L=*)⓪ ⓪$PROCEDURE delSymAddr (diff: LONGCARD; ende: LONGCARD);⓪&BEGIN⓪(IF hadSyms & protocol & (symbol # NIL) THEN⓪*REPEAT⓪,symbol^.addr:= $00FFFFFF;⓪,symbol:= symbol^.next;⓪*UNTIL (symbol = NIL) OR (symbol^.addr = ende)⓪(END⓪&END delSymAddr;⓪ ⓪$PROCEDURE setSymAddr (diff: LONGCARD; ende: LONGCARD);⓪&BEGIN⓪(IF hadSyms & protocol & (symbol # NIL) THEN⓪*REPEAT⓪,DEC (symbol^.addr, diff);⓪,symbol:= symbol^.next;⓪*UNTIL (symbol = NIL) OR (symbol^.addr = ende)⓪(END⓪&END setSymAddr;⓪ ⓪$VAR movedDiff: LONGCARD; (* Offset d. Verschiebung *)⓪ ⓪$BEGIN (* moveProcs *)⓪&WITH ModLst^[modIdx] DO⓪(imag:= image;⓪(symbol:= symbolRoot;⓪(hadSyms:= procSym;⓪((*IF hadSyms THEN Debug.Active:= TRUE; Debug.Continuous:= FALSE; END;*)⓪(remProcSym:= noProcSyms & hadSyms;⓪(IF remProcSym THEN procSym:= FALSE END;⓪(currEnd:= entry (image, 42); (* Codebeginn *)⓪(freeStart:= currEnd;⓪(lastEnd:= currEnd;⓪(movedDiff:= 0;⓪(procsExported:= FALSE; (* noch keine Procs exportiert *)⓪(endOfLenList:= FALSE;⓪((*⓪)* Der Code vom Body macht Probleme, weil er nicht in der ProcLenList⓪)* auftaucht. Deshalb wird hier eine Hilfsvar. "body_prl" eingesetzt,⓪)* die ggf. v. "getProc" entsprechend benutzt wird:⓪)*)⓪(body_prl.start:= entry (imag, 6);⓪(IF hadSyms THEN (* start muß _vor_ Proc-Name stehen *)⓪*setBeforeProcName (body_prl.start);⓪(END;⓪(body_prl.len:= codeEnd - body_prl.start;⓪(mark (ADR(body_prl), 1); (* Body als benutzt markieren *)⓪(REPEAT⓪*(* Zu entfernende, hintereinander liegende Procs sammeln *)⓪*WHILE optProcs & getProc (currEnd, prl) & NOT marked (prl) DO⓪,currEnd:= pEnd (prl);⓪,delSymAddr (movedDiff, currEnd);⓪*END;⓪*usedStart:= currEnd;⓪*(* usedStart: Ende zu entfernender Procs/Anfang zu erhaltender Procs *)⓪*(*⓪,IF (modIdx = 26) & (currEnd>=codeEnd) THEN⓪.TOSDebug.Active:= TRUE; TOSDebug.Step:= 0; TOSDebug.Continuous:= FALSE⓪,END;(*$D+*)⓪**)⓪*LOOP⓪,(* zusammenhängende, nicht zu entfernende Procs sammeln *)⓪,IF ~getProc (currEnd, prl) THEN⓪.IF currEnd # dataEnd THEN HALT END;⓪.IF remProcSym THEN⓪0IF usedStart < codeEnd THEN skipProcName (usedStart) END;⓪.END;⓪.EXIT (* -> end of code & data *)⓪,END;⓪,IF marked (prl) OR ~optProcs THEN⓪.(* unbenutzt:⓪0IF markedValue (prl) = 2 THEN procsExported:= TRUE END;⓪.*)⓪.currEnd:= pEnd (prl);⓪.IF remProcSym THEN⓪0IF usedStart < codeEnd THEN skipProcName (usedStart) END;⓪0EXIT (* -> move single proc *)⓪.ELSIF hadSyms & protocol THEN⓪0EXIT (* -> move single proc *)⓪.END⓪,ELSE⓪.EXIT (* -> move one or more procs *)⓪,END⓪*END;⓪*setSymAddr (movedDiff, currEnd);⓪*IF usedStart # freeStart THEN⓪,moveCode (modIdx, lastEnd, usedStart, currEnd, freeStart);⓪,INC (movedDiff, LONGCARD(usedStart - lastEnd))⓪*END;⓪*(* Diese Abfrage trifft leider auch bei korrekten Modulen zu:⓪,IF lastEnd = currEnd THEN⓪.HALT (* Es kam eine leere Proc/Konstante vor! Muß übersprungen werden *)⓪,END;⓪**)⓪*lastEnd:= currEnd;⓪*lastFree:= freeStart;⓪*freeStart:= freeStart + (currEnd - usedStart);⓪(UNTIL endOfLenList;⓪(IF symbol # NIL THEN HALT END;⓪(offset:= usedStart - lastFree;⓪(DEC (codeEnd, offset);⓪(DEC (dataEnd, offset);⓪(DEC (varStart, offset);⓪&END;⓪$END moveProcs;⓪"(*$D-*)⓪ ⓪ ⓪"VAR modidx: tIndex;⓪ ⓪"BEGIN (* Optimize *)⓪$IF optProcs THEN⓪&Report (3, 'Optimizing');⓪&IF ~noShModLst THEN WriteString (' / leaving data for debugging') END;⓪&WriteString ('...');⓪&FOR modidx:= 1 TO ModIndex DO⓪(WITH ModLst^[modidx] DO⓪*useCode:= mainMod OR NOT mayRemove⓪(END⓪&END;⓪&FOR modidx:= 1 TO ModIndex DO⓪(WITH ModLst^[modidx] DO⓪*IF useCode & NOT bodyMarked THEN⓪,bodyMarked:= TRUE;⓪,markCalls (modidx, entry (image, 6) (* Body-Einsprung *), codeEnd)⓪*END⓪(END⓪&END;⓪$ELSIF noProcSyms THEN⓪&Report (3, 'Removing procedure labels...');⓪$END;⓪$IF optProcs OR noProcSyms OR noHeader OR noShModLst THEN⓪&FOR modidx:= 1 TO ModIndex DO⓪(WITH ModLst^[modidx] DO⓪*IF mayCrunch THEN⓪,moveProcs (modidx)⓪*END;⓪(END⓪&END;⓪$END;⓪"END Optimize;⓪"(*$D-*)⓪ ⓪ PROCEDURE GenerateSymbolList;⓪"VAR modidx: tIndex;⓪&pn: POINTER TO LONGCARD;⓪&p: POINTER TO BYTE;⓪&ps: SymbolList;⓪&i, len: CARDINAL;⓪&prevSym: ADDRESS;⓪&rec: SymbolEntry;⓪&body: BOOLEAN;⓪"BEGIN⓪$(* zuerst Platz für die einzelnen Modulbeschreibungen (ModDesc) reservieren *)⓪$INC (symBufHead, ModIndex * TSIZE (ModDesc));⓪$IF symBufHead >= symBufEnd THEN⓪&RelError (FALSE);⓪$END;⓪$(* nun die Symbole anfügen *)⓪$FOR modidx:= 1 TO ModIndex DO⓪&WITH ModLst^[modidx] DO⓪(IF procSym THEN⓪*body:= TRUE;⓪*prevSym:= NIL;⓪*pn:= image + entry (image, 6) (* ^Body *) - 4;⓪*LOOP (* jeden Proc-Namen... *)⓪,len:= SHORT(LONGCARD(ADR (rec.name) - ADR (rec))) + 2;⓪,p:= ADDRESS(pn) - 2;⓪,(* Beginn d. Namens finden, Länge zählen *)⓪,IF body THEN⓪.(* Body wird als "BEGIN" protok., deswg. diese Länge zählen: *)⓪.INC (len, LENGTH ("BEGIN")+1);⓪.IF ODD(len) THEN INC (len) END⓪,END;⓪,REPEAT⓪.IF ~body THEN INC (len, 2) END;⓪.DEC (p, 2);⓪,UNTIL p^ = BYTE(0);⓪,(* Namen in Symbol-Puffer eintragen, rückwärts verketten *)⓪,ps:= symBufHead;⓪,INC (symBufHead, len);⓪,IF symBufHead >= symBufEnd THEN⓪.RelError (FALSE);⓪,END;⓪,WITH ps^ DO⓪.typ := 0;⓪.next:= prevSym;⓪.addr:= p - image;⓪.IF body THEN⓪0body:= FALSE;⓪0name:= "BEGIN";⓪.ELSE⓪0i:= 0;⓪0REPEAT⓪2INC (p);⓪2name[i]:= CHAR(p^);⓪2INC (i);⓪0UNTIL (p^ = BYTE(0)) OR (i = MaxSymbolLen);⓪0name[i]:= 0C;⓪.END⓪,END;⓪,prevSym:= ps;⓪,(* next symbol... *)⓪,IF pn^ = 0 THEN EXIT (* end of list *) END;⓪,pn:= image + pn^ - 4⓪*END;⓪*symbolRoot:= ADDRESS(ps);⓪(END;⓪&END⓪$END⓪"END GenerateSymbolList;⓪ ⓪ PROCEDURE FixSymbols;⓪"VAR modidx: tIndex; p: SymbolList;⓪"BEGIN⓪$FOR modidx:= 1 TO ModIndex DO⓪&WITH ModLst^[modidx] DO⓪(IF useCode THEN⓪*p:= symbolRoot;⓪*WHILE p # NIL DO⓪,IF p^.addr < $FFFFFF THEN DEC (p^.addr, diff) END;⓪,p:= p^.next⓪*END;⓪(END⓪&END⓪$END⓪"END FixSymbols;⓪ ⓪ PROCEDURE SymbolOutput (REF symarg: ARRAY OF CHAR): BOOLEAN;⓪"VAR nextMod, m: ModList; modidx: tIndex;⓪"BEGIN⓪$(* reservierte ModDesc-Einträge (s. GenerateSymbolList) ausfüllen *)⓪$m:= symbolBuf;⓪$FOR modidx:= 1 TO ModIndex DO⓪&nextMod:= ADDRESS(m) + SIZE (ModDesc);⓪&IF modidx = ModIndex THEN nextMod:= NIL END;⓪&WITH ModLst^[modidx] DO⓪(m^.next:= nextMod;⓪(m^.codeAdr:= codeAd;⓪(IF useCode THEN⓪*m^.codeLen:= codeEnd-codeAd;⓪(ELSE⓪*m^.codeLen:= 0⓪(END;⓪(m^.varAdr:= varAd;⓪(m^.varLen:= varLen;⓪(m^.dataAdr:= NIL;⓪(m^.dataLen:= 0;⓪(m^.sourceName:= sourceName;⓪(m^.codeName:= codeName;⓪(m^.name:= name;⓪(m^.symbolRoot:= symbolRoot;⓪(m^.compOpts:= compOpts;⓪(m^.mainMod:= mainMod;⓪&END;⓪&m:= nextMod⓪$END;⓪$RETURN OutputSymbols (symarg, outName, symbolBuf);⓪"END SymbolOutput;⓪ ⓪ ⓪ PROCEDURE bit (n: CARDINAL; l: ARRAY OF WORD): BOOLEAN;⓪"(*$L-*)⓪"BEGIN⓪$ASSEMBLER⓪(MOVE.W -(A3),D2⓪(MOVE.L -(A3),A0⓪(MOVE.W -(A3),D1⓪(TST D2⓪(BEQ wd⓪(MOVE.L (A0),D0⓪(BRA lg⓪%wd MOVE.W (A0),D0⓪%lg BTST D1,D0⓪(SNE D0⓪(ANDI #1,D0⓪$END⓪"END bit;⓪"(*$L=*)⓪ ⓪ ⓪ PROCEDURE ExecMod (mname: tModName; (* Name des gewuenschten Moduls *)⓪2reqkey: LONGCARD; (* gewuenschter Key *)⓪2client: tIndex) (* Index des Klienten *)⓪8: tIndex; (* vergebener Index *)⓪ ⓪"(* Laedt das Modul "mname" und liefert dessen Index in der "ModLst"⓪#* als Ergebnis.⓪#* Der Modulkey "reqkey" wird erwartet und ueberprueft.⓪#* Falls ein Fehler beim Relozieren oder Laden auftritt,⓪#* wird der benoetigte Speicher freigegeben und als Ergebnis⓪#* "BadIndex" geliefert⓪#*)⓪$⓪"VAR⓪.i: tIndex;⓪%clientname,⓪*fname: tModName;⓪-ad: address;⓪"⓪$⓪"PROCEDURE LoadMod (mname, fname: tModName): tIndex;⓪ ⓪$(* Laedt ein Modul in den Speicher, ueberprueft das Format⓪%* und traegt in die Modul-Liste ein. Reloziert nicht!⓪%* Wenn ein Fehler auftritt, wird der benutzte Speicher⓪%* freigegeben und als Modul-Index BadIndex geliefert⓪%*)⓪ ⓪$PROCEDURE ImportLen (image: address): LongCard;⓪&⓪&(* Laenge der Importliste des Moduls, das bei image steht,⓪)in Bytes ermitteln⓪&*)⓪&⓪&VAR s: address; n: LONGCARD;⓪&⓪&BEGIN⓪(s:= entry (image, 14);⓪(IF s = NIL THEN⓪*RETURN 0L⓪(ELSE⓪*n:= 4; (* Platz für Import-Liste (s. PutMod) *)⓪*s:= s+image;⓪*WHILE entry (s, 0) # 0L DO⓪,inc (s, 4);⓪,WHILE cardinal (s^) MOD 256 # 255 DO inc (s, 2) END;⓪,inc (s, 2);⓪,WHILE cardinal (s^) # 0 DO inc (s, 6) END;⓪,inc (s, 2);⓪,INC (n, 4);⓪*END;⓪*RETURN s+4L-image-entry (image, 14) - n⓪(END⓪&END ImportLen;⓪$⓪$VAR foundkey: LongCard; (* Key des geladenen Moduls *)⓪-ModAdr: Address; (* Anfang des geladenen Moduls *)⓪.found: Boolean; (* fuer FileSearch *)⓪,DriveNr: Cardinal; (* " *)⓪.VolNr: Cardinal; (* " *)⓪0ad1: address; (* fuer Storage-Anforderungen *)⓪0len: longcard; (* -"- *)⓪-layout: CARDINAL;⓪+realCode: CARDINAL;⓪-mname0: POINTER TO tModName;⓪,badFile: BOOLEAN;⓪-dummys: ARRAY [0..127] OF CHAR;⓪$⓪$BEGIN (* LoadMod *)⓪&IF ModIndex < LinkerParm.maxLinkMod THEN⓪(inc (ModIndex);⓪&ELSE⓪((*** Leider ist die Liste übergelaufen: ***)⓪(error (clientname, mname, TooManyMods);⓪(DeAllocate (ad1,0L);⓪(RETURN BadIndex⓪&END;⓪&⓪&SearchFile (fname,paths,fromStart,found,fname);⓪&Open (loadFile,fname,readonly);⓪&IF state (loadfile) < 0 THEN⓪(error (clientname,mname,notfound);⓪(RETURN BadIndex⓪&END;⓪ ⓪&len:= FileSize (loadFile);⓪&Allocate (ad1, len);⓪&IF ad1 = NIL THEN⓪(Close (loadFile);⓪(error (clientname,mname,nospace);⓪(RETURN BadIndex⓪&END;⓪ ⓪&ReadBytes (loadFile, ad1, len, len);⓪&ior:= State (loadFile);⓪&ResetState (loadFile);⓪&Close (loadFile);⓪&IF IOR<0 THEN⓪(error (clientname,mname,readerr);⓪(DeAllocate (ad1,0L);⓪(RETURN BadIndex⓪&END;⓪ ⓪&ASSEMBLER⓪(MOVE.L ad1(A6),A0⓪(CMPI.L #$4D4D3243,(A0)+ ; "MM2C"⓪(BNE nocode⓪(CMPI.L #$6F646500,(A0)+ ; "ode"⓪&nocode⓪(SNE D0⓪(ANDI #1,D0⓪(MOVE D0,badFile(A6)⓪&END;⓪&IF badFile THEN⓪(error (clientname,mname,badlayout);⓪(DeAllocate (ad1,0L);⓪(RETURN BadIndex⓪&END;⓪ ⓪&ModAdr:= ad1+8L;⓪ ⓪&layout:= Short (entry (ModAdr, 0) DIV 65536L);⓪&ASSEMBLER⓪(MOVE.W layout(A6),D0⓪(LSR.B #5,D0⓪(ANDI #3,D0⓪(MOVE.W D0,realCode(A6)⓪&END;⓪&(*⓪(IF (layout DIV 256) < 1 THEN⓪*error (clientname,mname,badlayout);⓪*DeAllocate (ad1,0L);⓪*RETURN BadIndex⓪(END;⓪&*)⓪&⓪&IF singleMod THEN⓪(singleMod:= FALSE;⓪(IF bit (1, layout) THEN⓪*error (clientname,mname,mustnotbeimpl);⓪*DeAllocate (ad1,0L);⓪*RETURN BadIndex⓪(END⓪&END;⓪&⓪&IF realCode # 0 THEN (* real im Code *)⓪(IF realForm # 0 THEN (* schon Real benutzt *)⓪*IF realCode # realForm THEN⓪,error (clientname,mname,badreal);⓪,DeAllocate (ad1,0L);⓪,RETURN BadIndex⓪*END⓪(ELSE⓪*ReportRealFormat (realCode-1);⓪*realForm:= realCode⓪(END⓪&END;⓪&⓪&foundkey:= entry (ModAdr, 2);⓪&IF (reqkey#anykey) & (reqkey#foundkey) THEN⓪(error (clientname,mname,badversion);⓪(DeAllocate (ad1,0L);⓪(RETURN BadIndex⓪&END;⓪&⓪&(*** Modul in ModLst eintragen ***)⓪*⓪&WITH ModLst^ [ModIndex] DO⓪(mainMod:= LoadingMain;⓪(useCode:= TRUE;⓪(varsExported:= FALSE;⓪(image := ModAdr;⓪(mayCrunch:= (layout DIV 256) >= 2;⓪(IF optProcs AND NOT mayCrunch THEN⓪*error (clientname,mname,nooptimize);⓪*RETURN BadIndex⓪(END;⓪(IF noHeader AND mayCrunch THEN⓪*diff:= entry (image, 42) (* ganzen Header weglassen *)⓪(ELSE⓪*diff:= ImportLen (image)⓪(END;⓪(varStart:= entry (ModAdr, 22);⓪(dataEnd:= varStart;⓪(codeEnd:= entry (ModAdr, 62);⓪(IF codeEnd = 0 THEN (* Data-Beginn undefiniert? *)⓪*codeEnd:= varStart;⓪(END;⓪(BodyLen:= BodyLen + (codeEnd - entry (ModAdr, 6));⓪(varAd := VarNow;⓪(varLen:= entry (ModAdr, 10) - varStart;⓪(key := foundkey;⓪(mname0:= ADDRESS (entry (ModAdr, 26)) + ModAdr;⓪(SplitPath (mname0^,dummys,sourcename);⓪(mname0:= ADDRESS (entry (ModAdr, 30)) + ModAdr;⓪(Assign (mname0^,name,ok);⓪(mname0:= ADDRESS (entry (ModAdr, 34)) + ModAdr;⓪(SplitPath (mname0^,dummys,symbolname);⓪(Assign (fname,codename,ok);⓪(symbolRoot:= NIL;⓪(compopts:= LONGSet(entry (ModAdr, 46));⓪(mayRemove:= NOT bit (2, compopts);⓪(procSym:= bit (4, layout);⓪(bodyMarked:= FALSE;⓪(useCode:= TRUE;⓪(crunched:= FALSE;⓪(ImpIndex:= 0;⓪(ImpLst:= NIL;⓪(varNow:= varNow + varlen;⓪(IF isCLinkMod (ModIndex) THEN⓪*WriteMod (ModIndex, conc ('©', name), fname);⓪(ELSE⓪*WriteMod (ModIndex, name, fname);⓪(END;⓪&END;⓪&LoadingMain:= FALSE;⓪&RETURN ModIndex;⓪$END LoadMod;⓪ ⓪ ⓪"PROCEDURE ImportMods (myIndex: tIndex): Boolean;⓪"⓪$VAR ReqKey: LongCard;⓪)ImPtr: address;⓪'ImIndex: tIndex;⓪,ok: boolean;⓪-i: cardinal;⓪ ⓪$BEGIN⓪&WITH ModLst^ [myIndex] DO⓪((* Anzahl der importierten Module bestimmen *)⓪((* und entspr. Speicher allozieren *)⓪(ImPtr:= image + entry (image, 14); (* ^ImportListe *)⓪(ReqKey:= entry (ImPtr, 0); (* importiertes Modul *)⓪(i:= 2;⓪(WHILE ReqKey # 0L DO⓪*inc (ImPtr, 4);⓪*SkipStr (ImPtr);⓪*SkipImpList (ImPtr);⓪*inc(i);⓪*ReqKey:= entry (ImPtr, 0)⓪(END; (* alle Importe abgearbeitet *)⓪(ALLOCATE (ImpLst, LONG (i) * TSIZE (tIndex));⓪(IF ImpLst = NIL THEN⓪*error (clientname,name,nospace)⓪(END;⓪ ⓪(ImPtr:= image + entry (image, 14); (* ^ImportListe *)⓪(ReqKey:= entry (ImPtr, 0); (* importiertes Modul *)⓪(ok:= true;⓪(WHILE (ReqKey # 0L) & ok DO⓪*inc (ImPtr, 4);⓪*ImIndex:= ExecMod (getstr (ImPtr), ReqKey, myIndex);⓪*IF ImIndex # BadIndex THEN⓪,SkipImpList (ImPtr);⓪,inc(ImpIndex);⓪,ImpLst^[ImpIndex]:= ImIndex⓪*ELSE⓪,ok:= false⓪*END;⓪*ReqKey:= entry (ImPtr, 0)⓪(END; (* alle Importe abgearbeitet *)⓪&END;⓪&RETURN ok⓪$END ImportMods;⓪"⓪"VAR s1,s2: tModName;⓪"⓪"BEGIN (* of ExecMod *)⓪$IF codesuffix THEN⓪&paths:= ImpPaths;⓪&ConcatName (mname, DefImpInSuf, fname)⓪$ELSE⓪&fname:= mname;⓪&SplitFileName (fname, mname, s1);⓪&Upper (s1);⓪&IF StrEqual (s1,DefImpInSuf) THEN⓪(paths:= ImpPaths⓪&ELSE⓪(paths:= ModPaths⓪&END⓪$END;⓪$codesuffix:= true;⓪$⓪$IF client = BadIndex THEN⓪&clientname:= mname⓪$ELSE⓪&Assign (ModLst^ [client].name, clientname, ok)⓪$END;⓪$⓪$Assign (mname,s1,ok);⓪$Upper (s1);⓪$FOR i:=1 TO ModIndex DO⓪&WITH ModLst^ [i] DO⓪(FastStrings.Assign (name,s2);⓪(Upper (s2);⓪(IF StrEqual (s1,s2) THEN⓪*IF (reqkey#anykey) & (reqkey#key) THEN⓪,error (clientname,mname,badversion);⓪,RETURN BadIndex⓪*ELSE⓪,(*** tatsaechlich: wir haben das richtige Modul im RAM ***)⓪,RETURN i⓪*END⓪(END⓪&END⓪$END;⓪$⓪$(*** Hier kommen wir an, wenn Modul nicht im RAM liegt ***)⓪$⓪$i:= LoadMod (mname, fname);⓪$IF i # BadIndex THEN (* Load war erfolgreich *)⓪&IF ImportMods (i) THEN⓪(inc (InitIndex);⓪(InitLst^[InitIndex]:= i; (* i zum Initialisieren vormerken *)⓪(RETURN i⓪&ELSE (* ImportMods ist schiefgegangen *)⓪(RETURN BadIndex⓪&END;⓪$ELSE (* Load ist schiefgegangen *)⓪&RETURN BadIndex⓪$END⓪"END ExecMod;⓪ ⓪ ⓪ ⓪ (*$L-,R-*)⓪ PROCEDURE PutIntoRelTab ( v: longcard );⓪"(* VAR d:longcard; *)⓪"BEGIN⓪$ASSEMBLER⓪(MOVE.L -(A3),D0⓪(TST.L firstRelVal⓪(BNE c0⓪(MOVE.L D0,firstRelVal⓪(BRA e0⓪ c0 CMP.L lastRelVal,D0⓪(BHI c1⓪ jErr CLR (A3)+⓪(JMP RelError ; Programmende⓪ c1 MOVE.L D0,D1⓪(SUB.L lastRelVal,D1⓪(⓪(MOVE.L pRelTab,A0⓪ l1 CMPA.L eRelTab,A0⓪(BCC jErr ; Listenüberlauf⓪(CMPI.L #256,D1⓪(BCS c2⓪(MOVE.B #1,(A0)+⓪(SUBI.L #254,D1⓪(BRA l1⓪ c2 MOVE.B D1,(A0)+⓪(MOVE.L A0,pRelTab⓪ ⓪ e0 MOVE.L D0,lastRelVal⓪$END⓪"END PutIntoRelTab;⓪ (*$L+,R+*)⓪ ⓪ ⓪ (*⓪!* Globale Vars:⓪!*)⓪ VAR ListTop: POINTER TO ARRAY [1..100000] OF pLONG;⓪'ListBeg: POINTER TO ARRAY [1..100000] OF pLONG;⓪%ListIndex: cardinal;⓪&LastDrop: pLONG;⓪)eoLists, Lists: pLONG;⓪ ⓪ ⓪ PROCEDURE dialog(): Boolean;⓪ ⓪"(*$R-*)⓪"PROCEDURE ClrList;⓪$VAR i : cardinal;⓪$BEGIN⓪&FOR i:= 1 TO ListIndex DO⓪(ListTop^[i]:= NIL⓪&END;⓪&ListIndex:= 0;⓪&LastDrop:= Lists⓪$END ClrList;⓪ ⓪"(*$R-,L-*)⓪"PROCEDURE SmallestInList() : LONGCARD;⓪$BEGIN⓪&ASSEMBLER⓪(MOVEQ #-1,D0⓪(CLR.W D1⓪(MOVEQ #1,D2⓪&forloop0⓪(CMP listIndex,D2⓪(BHI forend0⓪(MOVE D2,D3⓪(SUBQ #1,D3⓪(ASL #2,D3⓪(MOVE.L ListTop,A0⓪(MOVE.L 0(A0,D3.W),A1⓪(CMPA.L #NIL,A1⓪(BEQ cont0⓪(MOVE.L (A1),D4⓪(CMP.L D4,D0⓪(BLS cont0⓪(MOVE.L D4,D0⓪(MOVE D2,D1⓪&cont0⓪(ADDQ #1,D2⓪(BRA forloop0⓪&forend0⓪(TST D1⓪(BEQ ende⓪(SUBQ #1,D1⓪(ASL #2,D1⓪(MOVE.L ListTop,A0⓪(MOVE.L 0(A0,D1.W),D2⓪(MOVE.L ListBeg,A1⓪(CMP.L 0(A1,D1.W),D2⓪(BNE cont1⓪(CLR.L 0(A0,D1.W)⓪(BRA cont2⓪&cont1⓪(SUBQ.L #4,0(A0,D1.W)⓪&cont2⓪(RTS⓪&ende⓪(CLR.L D0⓪&END⓪$END SmallestInList;⓪"⓪"(*$R-,L+*)⓪"PROCEDURE reloc (myMod, imMod: ptrModDesc; VAR ImPtr: ADDRESS; VAR ok: BOOLEAN);⓪$BEGIN⓪&ASSEMBLER⓪(MOVEM.L D3/D4/D6/A4/A5,-(A7)⓪ ⓪(MOVE.L myMod(A6),A4⓪(MOVE.L tModDesc.image(A4),A4 ;^ zu relozierendes Modul⓪(⓪(MOVE.L ImPtr(A6),A1⓪(MOVE.L (A1),A1⓪(MOVEQ #1,D6 ;noch ist alles 'ok'⓪(⓪(MOVE.L A6,-(A7)⓪(MOVE.L imMod(A6),A6 ;A6 ist ^ModLst^ [ImIndex]⓪(MOVE.L tModDesc.image(A6),A2 ;A2 zeigt auf imp. Modul⓪!⓪!!RE6 MOVE.W (A1)+,D0 ;imp. ItemNr⓪(BEQ.L RE5 ;fertig mit diesem Import⓪(MOVE.L 18(A2),D3 ;Offset zur Exp.liste⓪(BEQ.L BAD ;keine da⓪(ADD.L A2,D3⓪(MOVE.L (A1)+,D1 ;importiertes Item⓪(BEQ RE6 ; wird gar nicht benutzt⓪ ⓪(MOVE ListIndex,D4⓪(CMP.W ListMax,D4⓪(BCC.W relerr2⓪(ADDQ #1,ListIndex⓪(MOVE.L ListBeg,A5⓪(MOVE ListIndex,D4⓪(SUBQ #1,D4⓪(LSL #2,D4⓪(CLR.L 0(A5,D4.W)⓪ ⓪(MOVE.L D3,A0⓪!!RE9 MOVE.W (A0)+,D2 ;Item in Exportliste suchen⓪(BEQ.W BAD ; schade - Liste zuende⓪(CMP.W D2,D0⓪(BEQ RE10 ;gefunden⓪(ADDQ.L #4,A0⓪(BRA RE9⓪!!RE10 MOVE.L (A0)+,D2 ;abs. ItemAdr ausrechnen⓪(BEQ re6 ;wurde wegoptimiert⓪(CMP.L 22(A2),D2⓪(BCC isVa2 ;das ist eine Var-Referenz⓪(ADD.L tModDesc.codeAd(A6),D2 ;Prozeduren: + Modulanfang⓪(SUB.L tModDesc.diff(A6),D2 ; - Importlisten-Laenge⓪(BRA RE11⓪!!isVa2 ADD.L tModDesc.varAd(A6),D2 ;Variablen: + VarAnfang⓪(ADD.L BSSstart,D2 ;Offset zu BSS addieren⓪(SUB.L 22(A2),D2⓪!!RE11 CMP.L 22(A4),D1 ;liegt Ref innerhalb des Codes ?⓪(BCC.W bad⓪(MOVE.L 0(A4,D1.L),D0 ;ItemAdr im Modul nachtragen⓪(MOVE.L D2,0(A4,D1.L)⓪ ⓪(MOVE.L (A7),A6⓪(MOVE.L A1,-(A7)⓪(MOVE.L myMod(A6),A5⓪(MOVE.L D1,D4⓪(ADD.L tModDesc.codead(A5),D4⓪(SUB.L tModDesc.diff(A5),D4⓪ ⓪(MOVE.L lastDrop,A5⓪(CMPA.L eoLists,A5⓪(BCC relerr1⓪(MOVE.L D4,(A5)⓪(MOVE listIndex,D4⓪(SUBQ #1,D4⓪(ASL #2,D4⓪(MOVE.L ListTop,A1⓪(MOVE.L A5,0(A1,D4.W)⓪(MOVE.L ListBeg,A1⓪(TST.L 0(A1,D4.W)⓪(BNE.S cont2⓪(MOVE.L A5,0(A1,D4.W)⓪&cont2⓪(ADDQ.L #4,lastDrop⓪ ⓪(MOVE.L (A7)+,A1⓪(MOVE.L imMod(A6),A6 ;A6 ist ^ModLst^ [ImIndex]⓪ ⓪(MOVE.L D0,D1⓪(BNE RE11⓪(BRA RE6⓪ ⓪&relerr2⓪(JMP RelError2⓪&relerr1⓪(CLR (A3)+⓪(JMP RelError⓪ ⓪!!bad CLR.W D6 ;FehlerFlag⓪!!RE5 MOVE.L (A7)+,A6 ;A6 wieder reparieren⓪(MOVE.L ImPtr(A6),A0⓪(MOVE.L A1,(A0)⓪(MOVE.L ok(A6),A0⓪(MOVE.W D6,(A0)⓪ ⓪(MOVEM.L (A7)+,D3/D4/D6/A4/A5⓪&END⓪$END reloc;⓪ ⓪"(*$R+,L+*)⓪"PROCEDURE Relocate ( myIndex: tIndex ) : Boolean;⓪"⓪$VAR v: LongCard;⓪)ImPtr: address;⓪'ImIndex: tIndex;⓪,ok: boolean;⓪-i: cardinal;⓪!main, importn: tModName;⓪(ptrMod: ptrModDesc;⓪(⓪$BEGIN⓪&(*** Zuerst die Var/Proc-Liste abarbeiten ***)⓪&⓪&ptrMod:= ADR (ModLst^ [myIndex]);⓪&Assign (ptrMod^.name, main, ok);⓪&ClrList;⓪&⓪&ASSEMBLER⓪/MOVEM.L D3/D4/D5/D6/A4/A5/A6,-(A7)⓪/MOVE.L ListTop,D4⓪/MOVE.L ListBeg,D5⓪/MOVE.W ListIndex,D6⓪/MOVE D6,D3⓪/SUBQ #1,D3⓪/ASL #2,D3⓪/MOVE.L lastDrop,A5⓪/MOVE.L ptrMod(A6),A1⓪ ⓪/MOVE.L tModDesc.image(A1),A4 ;A4 zeigt auf Modul-Bild im RAM⓪/MOVE.L 22(A4),A0 ;^Var/ProcListe⓪/ADDA.L A4,A0⓪(!RE3 MOVE.L (A0)+,D0 ;^letzte Ref⓪/BEQ.W RE1 ;Ende der Liste⓪/⓪/MOVE.L (A0)+,D1 ;rel. Adresse⓪/BEQ re3 ;wurde wegoptimiert⓪ ⓪/CMP.W ListMax,D6 ;ListIndex⓪/BCC.W relerr2b⓪/ADDQ #1,D6 ;ListIndex⓪/ADDQ #4,D3⓪/MOVE.L D5,A6⓪/CLR.L 0(A6,D3.W)⓪ ⓪/CMP.L 22(A4),D1⓪/BCC isVar ;das ist eine Var-Referenz⓪/ADD.L tModDesc.codeAd(A1),D1 ;Prozeduren: + Modulanfang⓪/SUB.L tModDesc.diff(A1),D1 ; - Importlisten-Laenge⓪/BRA RE2⓪(!isVar ADD.L tModDesc.varAd(A1),D1 ;Variablen: + VarAnfang⓪/ADD.L BSSstart,D1 ;Offset zu BSS addieren⓪/SUB.L 22(A4),D1⓪(!RE2 CMP.L 22(A4),D0 ;liegt Ref innerhalb des Codes ?⓪/BCC.S bad2⓪/MOVE.L 0(A4,D0.L),D2 ;^naechste Ref⓪/MOVE.L D1,0(A4,D0.L) ;Adresse eintragen⓪ ⓪/ADD.L tModDesc.codead(A1),D0⓪/SUB.L tModDesc.diff(A1),D0⓪ ⓪/CMPA.L eoLists,A5⓪/BCC.S relerr⓪/MOVE.L D0,(A5)⓪/MOVE.L D4,A6⓪/MOVE.L A5,0(A6,D3.W)⓪/MOVE.L D5,A6⓪/TST.L 0(A6,D3.W)⓪/BNE.S cont⓪/MOVE.L A5,0(A6,D3.W)⓪-cont⓪/ADDQ.L #4,A5⓪ ⓪/MOVE.L D2,D0⓪/BNE RE2 ;weitere Refs auf dieses Objekt⓪/BRA RE3 ;pruefe, ob weitere Objekte⓪ ⓪-relerr⓪/CLR (A3)+⓪/JMP RelError⓪-relerr2b⓪/JMP RelError2⓪ ⓪(!bad2⓪/MOVE.W D6,ListIndex⓪/MOVE.L A5,lastDrop⓪/MOVEM.L (A7)+,D3/D4/D5/D6/A4/A5/A6⓪/END; error ('',main,relocerr); ASSEMBLER⓪/BRA RE0⓪ ⓪(!RE1 MOVE.L A5,lastDrop⓪/MOVE.W D6,ListIndex⓪/MOVEM.L (A7)+,D3/D4/D5/D6/A4/A5/A6⓪)RE0⓪&END;⓪ ⓪((*** Jetzt kümmern wir uns um die Importe ***)⓪&⓪&WITH ptrMod^ DO⓪(ImPtr:= image + entry (image, 14); (* ^ImportListe *)⓪(i:= 1;⓪(ok:= TRUE;⓪(WHILE ( i <= ImpIndex ) & ok DO⓪*inc (ImPtr, 4);⓪*Skipstr (ImPtr); (* ImPtr hinter Namen setzen *)⓪*ImIndex:= ImpLst^[i];⓪*Assign (ModLst^ [ImIndex].name, importn, ok);⓪*reloc (ptrMod, ADR (ModLst^ [ImIndex]), ImPtr, ok);⓪*IF ~ok THEN error (importn,main,relocerr) END;⓪*inc(i)⓪(END; (* alle Importe abgearbeitet *)⓪&END; (* with ModLst^ [myIndex] *)⓪ ⓪&(* Alle f. dieses Modul relozierten Adressen in RelTab eintragen *)⓪&⓪&v:= SmallestInList();⓪&WHILE v # 0L DO⓪(PutIntoRelTab(v);⓪(v:= SmallestInList()⓪&END;⓪&⓪&RETURN ok⓪$END Relocate;⓪ ⓪ ⓪"PROCEDURE setCodeAd;⓪$VAR i: tIndex;⓪$BEGIN⓪&FOR i:= 1 TO ModIndex DO⓪(WITH ModLst^ [i] DO⓪*IF useCode THEN⓪,modlen:= dataEnd - diff;⓪,codeAd:= CodeNow;⓪,CodeNow:= CodeNow + modlen⓪*ELSE⓪,ClearMod (i);⓪,DEC (UsedCodes);⓪,DEC (UsedInits);⓪,modlen:= 0⓪*END⓪(END⓪&END;⓪$END setCodeAd;⓪ ⓪ ⓪"PROCEDURE AnotherMod ():BOOLEAN;⓪$VAR c:CHAR;⓪$BEGIN⓪&Prompt (1, 'Another module (Y/N) ? ');⓪&REPEAT⓪(Read (c);⓪(c:=CAP(c);⓪&UNTIL (c='Y') OR (c='N') OR (c=33C) OR (c=15C);⓪&RETURN (c='Y') OR (c=15C)⓪$END AnotherMod;⓪"⓪"VAR i,j: cardinal;⓪*ln: INTEGER;⓪%DriveNr: Cardinal;⓪'VolNr: Cardinal;⓪)len: Cardinal;⓪+f: file;⓪%modName: string;⓪ nameProvided: BOOLEAN;⓪"modNameIdx: CARDINAL;⓪&outsuf: String;⓪+s: string;⓪%symargs: String;⓪ initlistargs: String;⓪$outFirst: boolean;⓪%inFirst: boolean;⓪(argc: CARDINAL;⓪(argv: ARRAY [0..9] OF PtrArgStr;⓪%modIdx2: tIndex;⓪$firstMod: BOOLEAN;⓪#linkCount: CARDINAL;⓪%gotLast: BOOLEAN;⓪%tabSize: LONGCARD;⓪$l, avail: LONGINT;⓪ ⓪"PROCEDURE asn (i: CARDINAL; VAR d: ARRAY OF CHAR);⓪$BEGIN⓪&IF s[2] # 0C THEN⓪(INC (argv[i], 2);⓪(FastStrings.Assign (argv[i]^, d);⓪&END⓪$END asn;⓪ ⓪"BEGIN (* of Dialog *)⓪$optProcs:= FALSE;⓪$noHeader:= FALSE;⓪$noShModLst:= FALSE;⓪$noProcSyms:= FALSE;⓪$outname:= '';⓪$nameProvided:= FALSE;⓪$modNameIdx:= 0;⓪$HeaderFlags:= {};⓪$symBufFact:= 1000;⓪$DATALen:= 0;⓪$DATAFileName:= '';⓪$InitArgCV (argc,argv);⓪$FOR i:= 1 TO argc-1 DO⓪&Assign (argv[i]^, s, ok);⓪&Upper (s);⓪&IF (s[0] = '-') OR (s[0] = '/') THEN⓪(CASE s[1] OF⓪(| '0'..'9':⓪,j:= 1;⓪,INCL (HeaderFlags, StrConv.StrToCard (s,j,ok));⓪(| 'R':⓪,j:= 2;⓪,j:= StrConv.StrToCard (s,j,ok);⓪,IF j >= 100 THEN ListMax:= j END;⓪(| 'S':⓪,protocol:= TRUE;⓪,asn (i, symargs);⓪(| 'I':⓪,initList:= TRUE;⓪,asn (i, initlistargs);⓪(| 'H':⓪,optProcs:= TRUE;⓪(| 'F':⓪,optProcs:= TRUE;⓪,noHeader:= TRUE;⓪,noShModLst:= TRUE;⓪,noProcSyms:= TRUE;⓪(| 'M':⓪,noProcSyms:= TRUE;⓪(| 'V':⓪,VerboseOutput;⓪(| 'O':⓪,asn (i, outname);⓪(| 'D':⓪,j:= 2;⓪,DATALen:= StrConv.StrToLCard (s,j,ok);⓪,IF DATALen = 0 THEN⓪.asn (i, DATAFileName);⓪.IF Empty (DATAFileName) THEN⓪0ReportError ("Option 'D' needs a file name or a number for the DATA size");⓪.ELSE⓪0Open (f, DATAFileName, readonly);⓪0IF State (f) < 0 THEN⓪2ReportError (conc ('Cannot open DATA file: ', DATAFileName));⓪0ELSE⓪2DATALen:= FileSize (f);⓪2Close (f)⓪0END;⓪.END⓪,END⓪(ELSE⓪*ReportError (conc ('Illegal option character: ', s[1]));⓪(END;⓪(argv[i]^[0]:= 0C⓪&ELSE⓪(IF ~nameProvided THEN⓪*nameProvided:= TRUE;⓪*modNameIdx:= i;⓪(ELSE⓪*ReportError (conc ('Illegal cmdline argument: ', s));⓪(END;⓪&END⓪$END;⓪$outFirst:= TRUE;⓪$REPEAT⓪&IF outFirst & (outname[0] = '') THEN⓪(SplitPath (argv[modNameIdx]^,s,outName);⓪(SplitName (outName,outName,outSuf);⓪(IF outName[0] # '' THEN⓪*IF Compare (outsuf, 'MOS') = equal THEN⓪,Append ('.TOS', outname, ok)⓪*ELSIF Compare (outsuf, 'MTP') = equal THEN⓪,Append ('.TTP', outname, ok)⓪*ELSIF Compare (outsuf, 'MAC') = equal THEN⓪,Append ('.ACC', outname, ok)⓪*END;⓪*FastStrings.Insert (s, 0, outname)⓪(END⓪&END;⓪&IF ~outFirst OR (outname[0] = 0C) THEN⓪(Prompt (0, 'Output file name? ');⓪(ReadString (outName);⓪&END;⓪&outFirst:= FALSE;⓪&IF outname[0] = 0C THEN⓪(RETURN false⓪&ELSIF NOT hasSuffix (outName) THEN⓪(Append (DefOutSuf, outname, ok)⓪&END;⓪&ReplaceHome (outName);⓪&Report (0, 'Output file name: ');⓪&Upper (outName);⓪&WriteString (outName);⓪&⓪&Create (outFile, outName, writeOnly, replaceOld);⓪&⓪&ior:= State (outFile);⓪&IF ior<0 THEN⓪(MyError (ior)⓪&END;⓪$UNTIL ior=0;⓪$ClearEOP;⓪$⓪$CodeNow:= 18 + LENGTH (CodeID) + 1 + SysVarSpace;⓪F(* Platz fuer Start-LEA's/JMP und PDB *)⓪$VarNow:= 0L;⓪$BodyLen:= 0;⓪$⓪$ModIndex:= 0;⓪$modIdx2:=0;⓪$firstMod:= TRUE;⓪$linkCount:= MIN (LLRange);⓪$gotLast:= FALSE;⓪$LOOP⓪&inFirst:= TRUE;⓪&REPEAT⓪(IF inFirst & (nameProvided) THEN⓪*WHILE (linkCount<=MAX(LLRange)) & ~LinkerParm.linkList[linkCount].valid DO⓪,INC (linkCount)⓪*END;⓪*IF linkCount>MAX(LLRange) THEN⓪,Assign (ArgV[modNameIdx]^,ModName,ok);⓪,gotLast:= TRUE⓪*ELSE⓪,Assign (LinkerParm.linkList[linkCount].name,ModName,ok);⓪,INC (linkCount)⓪*END⓪(ELSIF nameProvided THEN⓪*ModName:= '' (* Programmabbruch *)⓪(ELSE⓪*Prompt (1, 'Module name? ');⓪*ReadString (ModName);⓪(END;⓪(inFirst:= FALSE;⓪(IF length (ModName) = 0 THEN⓪*Remove (outfile);⓪*RETURN false⓪(ELSIF NOT hasSuffix (ModName) THEN⓪*ConcatName (modname, DefPrgInSuf, modname);⓪(END;⓪(DiscardMods (modIdx2);⓪(Report (1, 'Module name: ');⓪(WriteString (ModName);⓪(IF firstMod THEN⓪*singleMod:= TRUE;⓪*InitIndex:= 0;⓪*ClearEOP;⓪(END;⓪((* Release geladene Moduln: *)⓪(WHILE ModIndex # modIdx2 DO⓪*DeAllocate (ModLst^ [ModIndex].ImpLst,0L);⓪*DeAllocate (ModLst^ [ModIndex].image,0L);⓪*DEC (ModIndex)⓪(END;⓪(LoadingMain:= TRUE;⓪(CodeSuffix:= false⓪&UNTIL ExecMod (modname, anykey, BadIndex) # BadIndex;⓪&IF firstMod THEN⓪(InitIdx2:= InitIndex⓪&END;⓪&IF nameProvided & gotLast THEN⓪(EXIT⓪&END;⓪&IF ~nameProvided & ~AnotherMod () THEN⓪(EXIT⓪&END;⓪&modIdx2:= ModIndex;⓪&firstMod:= FALSE⓪$END;⓪$⓪$(* Alles geladen, nun kann alles reloziert werden *)⓪$⓪$IF initList THEN⓪&IF NOT OutputInitList (initlistargs, outName, InitLst^, InitIndex, InitIdx2) THEN⓪(Remove (outfile);⓪(RETURN false⓪&END;⓪$END;⓪$⓪$(* Symbole in Liste eintragen *)⓪$IF protocol THEN⓪&symBufSize:= INT (MemAvail ()) - $1000;⓪&IF symBufSize < $1000 THEN RelError (FALSE) END;⓪&ALLOCATE (symbolBuf, symBufSize);⓪&symBufEnd:= symbolBuf + ORD(symBufSize);⓪&symBufHead:= symbolBuf;⓪&GenerateSymbolList;⓪$END;⓪$⓪$(* evtl. noch optimieren... *)⓪$Optimize;⓪$⓪$(* CodeNow & Adr. der Module ermitteln *)⓪$UsedCodes:= ModIndex;⓪$UsedInits:= InitIndex;⓪$setCodeAd;⓪$⓪$(* Symbolliste ausgeben und Speicher wieder freigeben *)⓪$IF protocol THEN⓪&FixSymbols;⓪&IF NOT SymbolOutput (symargs) THEN⓪(Remove (outfile);⓪(RETURN false⓪&END;⓪&DEALLOCATE (symbolBuf, 0);⓪$END;⓪$⓪$Report (3, 'Relocating...');⓪$⓪$tabSize:= SIZE (ListTop^[1]) * ListMax;⓪$avail:= INT (MemAvail ()) - $2000 - INT (MaxBlSize) - INT(2*tabSize);⓪$IF avail < $2000 THEN RelError (FALSE) END;⓪$ALLOCATE (ListTop, tabSize);⓪$ALLOCATE (ListBeg, tabSize);⓪$IF (ListTop = NIL) OR (ListBeg = NIL) THEN RelError (TRUE) END;⓪$DEC (avail, 2*tabSize);⓪$Allocate ( RelocTab, avail DIV 3 );⓪$pRelTab:= RelocTab; eRelTab:= RelocTab + ORD(avail) DIV 3 - 4;⓪$l:= avail - (avail DIV 3); IF ODD (l) THEN DEC (l) END;⓪$Allocate (Lists, l+4);⓪$ListIndex:= ListMax; eoLists:= ADDRESS (Lists) + ORD (l);⓪$IF (RelocTab = NIL)⓪$OR (Lists = NIL) THEN RelError (TRUE); END;⓪$⓪$IF noShModLst THEN⓪&ShModLstLen:= 0⓪$ELSE⓪&ShModLstLen:= long (UsedCodes) * ShModLstSpace;⓪$END;⓪$⓪$DATAStart:= CodeNow + long (4*(UsedInits-1)+8) + ShModLstLen;⓪$BSSstart:= DATAStart+ORD(DATALen);⓪$WITH ModLst^ [InitLst^[InitIdx2]] DO⓪&initOffs:= codeAd + entry (Image, 6) - diff;⓪$END;⓪$⓪$PutIntoRelTab(2L); (* LEA reloz. *)⓪$PutIntoRelTab(8L); (* LEA reloz. *)⓪$IF initOffs >= 32768 THEN⓪&PutIntoRelTab(14L); (* JMP am Code-Anfang reloz. *)⓪$END;⓪$IF NOT noShModLst THEN⓪&PutIntoRelTab(24 + LENGTH (CodeID) + 1); (* ^ShModLst reloz. *)⓪$END;⓪$⓪$FOR i:=1 TO ModIndex DO⓪&IF ModLst^ [i].useCode THEN⓪(IF ~Relocate(i) THEN⓪*Remove (outfile);⓪*RETURN false⓪(END⓪&END⓪$END;⓪$⓪$DEALLOCATE (ListTop, 0);⓪$DEALLOCATE (ListBeg, 0);⓪$DeAllocate (Lists, 0L);⓪$⓪$IF ~nameProvided THEN⓪&REPEAT⓪(Prompt (2, 'Stack size (0 for default)? ');⓪(ReadString (s);⓪(i:=0;⓪(stacksize:= StrConv.StrToLCard (s,i,ok)⓪&UNTIL (stacksize=0L) OR (stacksize>255L)⓪$ELSE⓪&stacksize:= LinkerParm.linkStackSize⓪$END;⓪$RETURN TRUE⓪"END dialog;⓪ ⓪ ⓪ PROCEDURE moveProcNames (image: ADDRESS; add: LONGINT);⓪"(*$L-*)⓪"BEGIN⓪$ASSEMBLER⓪(MOVE.L -(A3),D0⓪(MOVE.L -(A3),A0⓪(MOVE.L 6(A0),D1 ; BODY-OFFSET⓪%l: LEA -4(A0,D1.L),A1⓪(MOVE.L (A1),D1⓪(ADD.L D0,(A1)⓪(TST.L D1⓪(BNE l⓪$END⓪"END moveProcNames;⓪"(*$L=*)⓪ ⓪ ⓪ PROCEDURE PutMod (i: tIndex);⓪ ⓪"(*⓪#* ImportListe aus dem Modul entfernen, Exportliste umrechnen,⓪#* Modul in outfile schreiben⓪#*)⓪"⓪"VAR s,d, img: address; idx: tIndex; pl: POINTER TO LONGCARD;⓪"⓪"BEGIN⓪$WITH ModLst^ [i] DO⓪ ⓪&IF procSym AND (diff # 0L) THEN⓪((*** Proc-Namen-Liste bzgl. 'diff' korrigieren ***)⓪(moveProcNames (image, -LONGINT(diff));⓪&END;⓪ ⓪&IF noHeader & mayCrunch THEN⓪ ⓪(img:= image + entry (image, 42)⓪ ⓪&ELSE⓪&⓪((*** Importliste loeschen, aber Pointer-Liste anlegen ***)⓪(⓪(IF diff # 0L THEN⓪*pl:= image + entry (image, 14); (* ^Importliste *)⓪*FOR idx:= 1 TO ImpIndex DO⓪,pl^:= ModLst^[ImpLst^[idx]].finalIdx;⓪,INC (pl,4)⓪*END;⓪*pl^:= 0;⓪*INC (pl,4);⓪*d:= pl;⓪*s:= d + diff;⓪*Block.Copy (s, (image + entry (image, 22)) - s, d);⓪(END;⓪(⓪((*** Exportliste umrechnen ***)⓪(⓪(d:= entry (image, 18);⓪(IF d # NIL THEN⓪*enter (image, 18, d - diff); (* ^ExportListe *)⓪*d:= d+image-diff;⓪*WHILE cardinal (d^) # 0 DO⓪,s:= entry (d, 2);⓪,IF s # 0L THEN⓪.IF s < entry (image, 22) THEN (* Procedure/Const *)⓪0enter (d, 2, s-diff)⓪.ELSE⓪0(*$r- die rel. Adressen der Variablen koennen negativ werden *)⓪0enter (d, 2, VarAd + BSSstart + s - entry (image, 22) - codeAd )⓪0(*$r=*)⓪.END;⓪,END;⓪,inc (d, 6)⓪*END⓪(END;⓪(⓪(img:= image⓪(⓪&END;⓪&⓪&enter (image, 6, entry (image, 6) - diff); (* ^Modulrumpf *)⓪&enter (image, 10, modlen); (* ^Modulende *)⓪&enter (image, 22, 0); (* ^Var/Proc *)⓪&enter (image, 42, entry (image, 42) - diff); (* ^CodeStart *)⓪ ⓪&(*** und wegschreiben ***)⓪ ⓪&fputm (outfile, img^, modlen)⓪ ⓪$END (* with ModLst^ [i] *)⓪"END PutMod;⓪#⓪#⓪ PROCEDURE CodeOutput;⓪ ⓪"(* Relozierte Module ins Ausgabe-File wegschreiben.⓪#* Dabei werden Import- und Relozierlisten entfernt,⓪#* Exportlisten muessen umgerechnet werden!⓪#*)⓪#⓪"CONST bra = $6000;⓪)nop = $4E71;⓪)jmp = $4EF9;⓪)jsr = $4EB9;⓪)rts = $4E75;⓪)lea1= $43F9; (* LEA xxxxxxxx,A1 *)⓪)lea2= $45F9; (* LEA xxxxxxxx,A2 *)⓪)⓪)bufsize = 4096;⓪"⓪"VAR j,i: tIndex;⓪%k,wbuf: cardinal;⓪)li: LONGINT;⓪'lbuf: longcard;⓪*p: address;⓪)ch: CHAR;⓪)bs: BITSET;⓪&idBuf: ARRAY [0..LENGTH (CodeID)] OF CHAR;⓪&dataf: File;⓪%buffer: ADDRESS;⓪ ⓪"BEGIN⓪$(* Command File Header schreiben *)⓪$wbuf:= $601A;⓪$fput (outfile, wbuf);⓪$fput (outfile, DATAstart); (* Länge TEXT *)⓪$fput (outfile, DATALen); (* Länge DATA *)⓪$fput (outfile, VarNow); (* Länge BSS *)⓪$lbuf:= 0L;⓪$fput (outfile, lbuf);⓪$lbuf:= 0L;⓪$fput (outfile, lbuf);⓪$lbuf:= CARDINAL (HeaderFlags); (* Fastload/Fast Code/Fast Memory-Bits *)⓪$fput (outfile, lbuf);⓪$wbuf:= 0;⓪$fput (outfile, wbuf);⓪$⓪$wbuf:= lea1; (* Zeiger auf import. Moduladr. -> A1 *)⓪$fput (outfile, wbuf);⓪$lbuf:= CodeNow + ShModLstLen;⓪$fput (outfile, lbuf);⓪$⓪$wbuf:= lea2; (* LEA PDB,A2 *)⓪$fput (outfile, wbuf);⓪$fput (outfile, VAL (LONGCARD, 18 + LENGTH (CodeID) + 1));⓪$⓪$(* 26.09.94: falls Differenz < 32K, dann BRA statt JMP verwenden, *⓪%* damit z.B. Templemon ohne Relozierung laufen kann. *)⓪$WITH ModLst^ [InitLst^[InitIdx2]] DO⓪&lbuf:= codeAd + entry (Image, 6) - diff;⓪$END;⓪$IF initOffs # lbuf THEN HALT END; (* Zur Sicherheit *)⓪$IF initOffs >= 32768 THEN⓪&wbuf:= jmp; (* JMP zum Init-Modul *)⓪&fput (outfile, wbuf);⓪&fput (outfile, lbuf);⓪$ELSE⓪&wbuf:= nop;⓪&fput (outfile, wbuf);⓪&wbuf:= bra; (* BRA zum Init-Modul *)⓪&fput (outfile, wbuf);⓪&wbuf:= short (lbuf - 16); (* rel. Offset ab BRA-Instr. bestimmen *)⓪&fput (outfile, wbuf);⓪$END;⓪$⓪$idBuf:= CodeID;⓪$fput (outfile, idBuf);⓪$⓪$(* PDB anlegen *)⓪$wbuf:= PDBlayout;⓪$fput (outfile, wbuf); (* layout *)⓪$lbuf:= 0L;⓪$fput (outfile, lbuf); (* ^basePage reservieren *)⓪$IF noShModLst THEN⓪&lbuf:= 0;⓪&wbuf:= 0⓪$ELSE⓪&lbuf:= codenow;⓪&wbuf:= UsedCodes;⓪$END;⓪$fput (outfile, lbuf); (* ^ShModLst (f. Loader) *)⓪$fput (outfile, wbuf); (* Anzahl der Einträge in ShModLst *)⓪$wbuf:= 0;⓪$fput (outfile, wbuf); (* processState *)⓪$lbuf:= 0L;⓪$fput (outfile, lbuf); (* BottomOfStack *)⓪$fput (outfile, stacksize); (* TopOfStack *)⓪$fput (outfile, lbuf); (* termState, resident *)⓪$ASSEMBLER⓪(MOVE realForm,D0⓪(TST extendedCode⓪(BEQ noExtCode⓪(ADDQ #4,D0⓪&noExtCode⓪(MOVE.W D0,wbuf(A6)⓪$END;⓪$fput (outfile, wbuf); (* flags *)⓪$fput (outfile, lbuf); (* TermProcs *)⓪$fput (outfile, lbuf); (* ^prev *)⓪$fput (outfile, lbuf); (* reserved *)⓪$fput (outfile, lbuf); (* reserved *)⓪$fput (outfile, lbuf); (* reserved *)⓪$fput (outfile, lbuf); (* reserved *)⓪$⓪$(* finalIdx berechnen *)⓪$j:= 0;⓪$FOR i:=1 TO ModIndex DO⓪&IF ModLst^ [i].useCode THEN⓪(INC (j);⓪(ModLst^ [i].finalIdx:= j;⓪&ELSE⓪(ModLst^ [i].finalIdx:= 0⓪&END⓪$END;⓪$IF UsedCodes # j THEN HALT END;⓪$⓪$(* Codes der Module ablegen *)⓪$FOR i:=1 TO ModIndex DO⓪&IF ModLst^ [i].useCode THEN⓪(WritingOut (i);⓪(PutMod (i);⓪(IF IOResult < 0 THEN⓪*MyError (IOResult);⓪*Remove (OutFile);⓪*RETURN⓪(END⓪&END⓪$END;⓪$⓪$IF NOT noShModLst THEN⓪&(* ShModLst ablegen *)⓪&j:= 0;⓪&FOR i:= 1 TO ModIndex DO⓪(WITH ModLst^ [i] DO⓪*IF useCode THEN⓪.(* head0: Adr. des Headers *)⓪0fput (outfile, codead);⓪0PutIntoRelTab ( codeNow + long (j) * ShModLstSpace );⓪.(* var0 *)⓪0lbuf:= varAd + BSSstart;⓪0fput (outfile, lbuf);⓪0PutIntoRelTab ( codeNow + long (j) * ShModLstSpace + 4 );⓪.(* varlen0 *)⓪0fput (outfile, varlen);⓪.(* flags *)⓪0bs:= {};⓪0IF procSym THEN INCL (bs,0) END;⓪0IF crunched THEN INCL (bs,1) END;⓪0IF NOT bit (25, compopts) (* $Y *) THEN INCL (bs, 2) END;⓪0IF mainMod THEN INCL (bs,3) END;⓪0fput (outfile, bs);⓪,INC (j)⓪*END⓪(END⓪&END⓪$END;⓪$⓪$(* Body-Adressen der Module zur Initialisierung in Liste schreiben *)⓪$⓪$j:= 0;⓪$(* vom ersten Modul importierte Moduladr. rausschreiben *)⓪$FOR i:=1 TO InitIdx2-1 (* Init-Mod nicht *) DO⓪&WITH ModLst^ [InitLst^[i]] DO⓪(IF useCode THEN⓪*lbuf:= CodeAd + entry (Image, 6) (* '-diff' in Putmod erledigt *);⓪*fput (outfile, lbuf);⓪*PutIntoRelTab ( codeNow + ShModLstLen + long (j * 4) );⓪*INC (j)⓪(END;⓪&END;⓪$END;⓪$⓪$lbuf:= 0L;⓪$fput (outfile, lbuf); (* Endekennung *)⓪$INC (j);⓪$⓪$(* von weiteren Modulen importierte Moduladr. rausschreiben *)⓪$FOR i:=InitIdx2+1 TO InitIndex DO⓪&WITH ModLst^ [InitLst^[i]] DO⓪(IF useCode THEN⓪*lbuf:= CodeAd + entry (Image, 6) (* '-diff' in Putmod erledigt *);⓪*fput (outfile, lbuf);⓪*PutIntoRelTab ( codeNow + ShModLstLen + long (j * 4) );⓪*INC (j)⓪(END⓪&END;⓪$END;⓪$⓪$lbuf:= 0L;⓪$fput (outfile, lbuf); (* Endekennung *)⓪$⓪$(* DATA-Segment erzeugen *)⓪$IF DATALen > 0 THEN⓪&ALLOCATE (buffer, bufsize); (* soviel wird sicher immer frei sein *)⓪&IF DATAFileName[0] # '' THEN⓪((* DATA aus Datei kopieren *)⓪(Open (dataf, DATAFileName, readonly);⓪&ELSE⓪((* Leeres DATA-Segment erzeugen *)⓪(Block.Clear (buffer, bufsize);⓪&END;⓪&WHILE DATALen > 0 DO⓪(li:= DATALen;⓪(IF li > bufsize THEN li:= bufsize END;⓪(IF DATAFileName[0] # '' THEN⓪*ReadBytes (dataf, buffer, li, lbuf)⓪(END;⓪(fputm (outfile, buffer^, li);⓪(DEC (DATALen, li);⓪&END;⓪&IF DATAFileName[0] # '' THEN⓪(Close (dataf)⓪&END⓪$END;⓪$⓪$(* Reloziertabelle schreiben *)⓪$lbuf:= pRelTab - RelocTab;⓪$IF lbuf > 32760L THEN⓪&ReportError (conc (conc ('Warning! Relocation table is ',⓪>StrConv.CardToStr (lbuf,0)),⓪9' bytes long (will not run on TOS 1.0/1.2)'));⓪$END;⓪$fput (outfile, firstRelVal);⓪$fputm (outfile, RelocTab^, lbuf);⓪$wbuf:= 0;⓪$fput (outfile, wbuf);⓪$⓪$Close (OutFile);⓪$IF State (outFile) < 0 THEN⓪&MyError (state(outfile));⓪&Remove (outfile);⓪$ELSE⓪&EndWriting;⓪$END;⓪"END CodeOutput;⓪ ⓪ ⓪ VAR dummy: PDB;⓪$ch: CHAR;⓪ ⓪ BEGIN (* ROMLoad *)⓪"IF SIZE (dummy.ModLst^[1]) # ShModLstSpace THEN HALT END;⓪"IF TSIZE (PDB) # SysVarSpace THEN HALT END;⓪"IF NOT ODD (LENGTH (CodeID)) THEN HALT END;⓪"⓪"IF LinkerParm.maxLinkMod >= (MAX (tIndex)-1) THEN⓪$LinkerParm.maxLinkMod:= MAX (tIndex)-2⓪"END;⓪"IF LinkerParm.maxLinkMod = 0 THEN LinkerParm.maxLinkMod:= 100 END;⓪"ListMax:= 1000;⓪"⓪"InitOutput (LinkerParm.maxLinkMod, conc ('Megamax Modula-2 Linker ',version));⓪"⓪"HomePath:= ShellPath; ⓪"⓪"ALLOCATE (ModLst, TSIZE (tModDesc) * LONG (LinkerParm.maxLinkMod+2));⓪"ALLOCATE (InitLst, TSIZE (tIndex) * LONG (LinkerParm.maxLinkMod+2));⓪"IF (ModLst = NIL) OR (ModLst = NIL) THEN⓪$ReportError ('Out of memory');⓪$TermProcess (MOSGlobals.OutOfMemory)⓪"END;⓪"DefPrgInSuf:= DftSfx;⓪"DefImpInSuf:= ImpSfx;⓪"RelocTab:= NIL;⓪"pRelTab:= NIL;⓪"firstRelVal:= 0L;⓪"lastRelVal:= 0L;⓪"realForm:= 0;⓪"extendedCode:= FALSE;⓪"IF dialog() THEN⓪$ReportCodeLen (DATAstart, VarNow, DATALen);⓪$BeginWriting;⓪$CodeOutput;⓪"ELSE⓪$TermProcess (1)⓪"END;⓪ END MM2Link.⓪ ə
- (* $FFE1220A$0001156A$000125A1$FFFD709E$FFFD709E$FFFD709E$FFFD709E$FFFD709E$FFFD709E$FFFD709E$FFFD709E$00001DD2$FFFD709E$00013BC1$FFFD709E$0000ADB9$FFFD709E$FFFD709E$FFFD709E$FFFD709E$0000FE06$FFFD709E$FFFD709E$FFFD709E$FFFD709E$FFFD709E$FFF6AA4D$00009428$FFFD709E$0000A492$FFFD709E$0000AF05$FFFD709E$FFFD709E$00004289$FFFD709E$FFF6AAC9$FFFD709E$00008454$FFFD709E$FFFD709E$FFFD709EÇ$00001D7DT.......T.......T.......T.......T.......T.......T.......T.......T.......T......T$FF77848C$00001DA5$0000A941$0000A9CA$0000A971$00000036$00000049$00000036$00000044$0000A941$0000A9CA$0000AD52$0000ADC5$00001DCE$00001D7D$FF77848CêÇâ*)
-
